Initial Commit
[packages] / xemacs-packages / text-modes / folding.el
1 ;;; folding.el --- A folding-editor-like minor mode.
2
3 ;; This file is not part of Emacs
4
5 ;; Copyright (C) 2000-2009
6 ;;           Jari Aalto
7 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999
8 ;;           Jari Aalto, Anders Lindgren.
9 ;; Copyright (C) 1994
10 ;;           Jari Aalto
11 ;; Copyright (C) 1992, 1993
12 ;;           Jamie Lokier, All rights reserved.
13 ;;
14 ;; Author:      Jamie Lokier <jamie A T imbolc.ucc dt ie>
15 ;;              Jari Aalto <jari aalto A T cante dt net>
16 ;;              Anders Lindgren <andersl A T csd.uu dt se>
17 ;; Maintainer:  Jari Aalto <jari aalto A T cante dt net>
18 ;; Created:     1992
19 ;; Keywords:    tools
20 ;;
21 ;; [Latest XEmacs CVS tree commit and revision]
22 ;; Vcs-Version: $Revision: 1.25 $
23 ;; Vcs-Date:    $Date: 2009-09-05 08:15:16 $
24 ;;
25 ;; [Latest devel version]
26 ;; Vcs-URL:     http://savannah.nongnu.org/projects/emacs-tiny-tools
27
28 (defconst folding-version-time "2009.0905.0811"
29   "Last edit time in format YYYY.MMDD.HHMM.")
30
31 ;;{{{ GPL
32
33 ;; This program is free software; you can redistribute it and/or
34 ;; modify it under the terms of the GNU General Public License as
35 ;; published by the Free Software Foundation,
36 ;; or (at your option) any later version.
37 ;;
38 ;; GNU Emacs is distributed in the hope that it will be useful,
39 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
40 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
41 ;; GNU General Public License for more details.
42 ;;
43 ;; You should have received a copy of the GNU General Public License
44 ;; along with program. If not, write to the
45 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
46 ;; Boston, MA 02110-1301, USA.
47 ;;
48 ;; Visit <http://www.gnu.org/copyleft/gpl.html> for more information
49
50 ;;}}}
51
52 ;;; Commentary:
53
54 ;;{{{ Introduction
55
56 ;; Preface
57 ;;
58 ;;      This package provides a minor mode, compatible with all major
59 ;;      editing modes, for folding (hiding) parts of the edited text or
60 ;;      program.
61 ;;
62 ;;      Folding mode handles a document as a tree, where each branch
63 ;;      is bounded by special markers `{{{' and `}}}'. A branch can be
64 ;;      placed inside another branch, creating a complete hierarchical
65 ;;      structure.
66 ;;
67 ;;      Folding mode can CLOSE a fold, leaving only the initial `{{{'
68 ;;      and possibly a comment visible.
69 ;;
70 ;;      It can also ENTER a fold, which means that only the current
71 ;;      fold will be visible, all text above `{{{' and below `}}}'
72 ;;      will be invisible.
73 ;;
74 ;;      Please note, that the maintainers do not recommend to use only
75 ;;      folding for you your code layout and navigation. Folding.el is
76 ;;      on its best when it can "chunk" large sections of code inside
77 ;;      folds. The larger the chunks, the more the usability of
78 ;;      folding will increase. Folding.el is not meant to hide
79 ;;      individual functions: you may be better served by hideshow.el
80 ;;      or imenu.el (which can parse the function indexes)
81
82 ;;}}}
83 ;;{{{ Installation
84
85 ;;  Installation
86 ;;
87 ;;      To install Folding mode, put this file (folding.el) on your
88 ;;      Emacs `load-path' (or extend the load path to include the
89 ;;      directory containing this file) and optionally byte compile it.
90 ;;
91 ;;      The best way to install folding is the autoload installation,
92 ;;      so that folding is loaded into your emacs only when you turn on
93 ;;      `folding-mode'. This statement speeds up loading your .emacs
94 ;;
95 ;;          (autoload 'folding-mode          "folding" "Folding mode" t)
96 ;;          (autoload 'turn-off-folding-mode "folding" "Folding mode" t)
97 ;;          (autoload 'turn-on-folding-mode  "folding" "Folding mode" t)
98 ;;
99 ;;      But if you always use folding, then perhaps you want more
100 ;;      traditional installation. Here Folding mode starts
101 ;;      automatically when you load a folded file.
102 ;;
103 ;;          ;; (setq folding-default-keys-function
104 ;;          ;;      'folding-bind-backward-compatible-keys)
105 ;;
106 ;;          (if (load "folding" 'nomessage 'noerror)
107 ;;              (folding-mode-add-find-file-hook))
108 ;;
109 ;;      Folding uses a keymap which conforms with the new Emacs
110 ;;      (started 19.29) style. The key bindings are prefixed with
111 ;;      "C-c@" instead of old "C-c". To use the old keyboard bindings,
112 ;;      uncomment the lines in the the above installation example
113 ;;
114 ;;      The same folding marks can be used in `vim' editor command
115 ;;      "set fdm=marker".
116 ;;
117 ;;  Uninstallation
118 ;;
119 ;;      To remove folding, call `M-x' `folding-uninstall'.
120 ;;
121 ;;  To read the manual
122 ;;
123 ;;      At any point you can reach the manual with `M-x'
124 ;;      `finder-commentary' RET folding RET.
125
126 ;;}}}
127 ;;{{{ DOCUMENTATION
128
129 ;;  Compatibility
130 ;;
131 ;;      Folding supports following Emacs flavors:
132 ;;
133 ;;          Unix Emacs  19.28+ and Win32 Emacs  19.34+
134 ;;          Unix XEmacs 19.14+ and Win32 XEmacs 21.0+
135 ;;
136 ;;  Compatibility not for old NT Emacs releases
137 ;;
138 ;;      NOTE: folding version starting from 2.47 gets around this bug
139 ;;      by using adviced kill/yank functions. The advice functions are
140 ;;      only instantiated under problematic NT Emacs versions.
141 ;;
142 ;;      Windows NT/9x 19.34 - 20.3.1 (i386-*-nt4.0) versions contained
143 ;;      a bug which affected using folding. At the time the bug was
144 ;;      reported by Trey Jackson <trey A T cs berkeley edu>
145 ;;
146 ;;          If you kill folded area and yank it back, the ^M marks are
147 ;;          removed for some reason.
148 ;;
149 ;;          Before kill
150 ;;          ;;{{{ fold...
151 ;;
152 ;;          After yank
153 ;;          ;;{{{ fold all lines together }}}
154 ;;
155 ;;  Relates packages or modes
156 ;;
157 ;;      Folding.el was designed to be a content organizer and it is most
158 ;;      suitable for big files. Sometimes people misunderstand the
159 ;;      package's capabilities and try to use folding.el in wrong places,
160 ;;      where some other package would do a better job. Trying to wrap
161 ;;      individual functions inside fold-marks is not where folding is
162 ;;      it's best. Grouping several functions inside a logical fold-block
163 ;;      in the other is. So, to choose a best tool for your need,
164 ;;      here are some suggestions,:
165 ;;
166 ;;      o  Navigating between or hiding individual functions -
167 ;;         use combination of imenu.el, speedbar.el and
168 ;;         hideshow.el
169 ;;      o  Organizing large blocks - use folding.el
170 ;;      o  For text, `outline-mode' is more non-intrusive than folding.
171 ;;         Look at Emacs NEWS file (`C-x' `n') and you can see beatifully
172 ;;         laid content.
173 ;;
174 ;;  Tutorial
175 ;;
176 ;;      To start folding mode, give the command: `M-x' `folding-mode'
177 ;;      `RET'. The mode line should contain the string "Fld" indicating
178 ;;      that folding mode is activated.
179 ;;
180 ;;      When loading a document containing fold marks, Folding mode is
181 ;;      automatically started and all folds are closed. For example when
182 ;;      loading my init file, only the following lines (plus a few lines
183 ;;      of comments) are visible:
184 ;;
185 ;;          ;;{{{ General...
186 ;;          ;;{{{ Keyboard...
187 ;;          ;;{{{ Packages...
188 ;;          ;;{{{ Major modes...
189 ;;          ;;{{{ Minor modes...
190 ;;          ;;{{{ Debug...
191 ;;
192 ;;      To enter a fold, use `C-c @ >'. To show it without entering,
193 ;;      use `C-c @ C-s', which produces this display:
194 ;;
195 ;;          ;;{{{ Minor modes
196 ;;
197 ;;          ;;{{{ Follow mode...
198 ;;          ;;{{{ Font-lock mode...
199 ;;          ;;{{{ Folding...
200 ;;
201 ;;          ;;}}}
202 ;;
203 ;;      To show everything, just as the file would look like if
204 ;;      Folding mode hadn't been activated, give the command `M-x'
205 ;;      `folding-open-buffer' `RET', normally bound to `C-c' `@'
206 ;;      `C-o'.  To close all folds and go to the top level, the
207 ;;      command `folding-whole-buffer' could be used.
208 ;;
209 ;;  Mouse support
210 ;;
211 ;;      Folding mode v2.0 introduced mouse support. Folds can be shown
212 ;;      or hidden by simply clicking on a fold mark using mouse button
213 ;;      3. The mouse routines have been designed to call the original
214 ;;      function bound to button 3 when the user didn't click on a
215 ;;      fold mark.
216 ;;
217 ;;  The menu
218 ;;
219 ;;      A menu is placed in the "Tools" menu. Should no Tools menu exist
220 ;;      (Emacs 19.28) the menu will be placed in the menu bar.
221 ;;
222 ;;  ISearch
223 ;;
224 ;;      When searching using the incremental search (C-s) facilities,
225 ;;      folds will be automagically entered and closed.
226 ;;
227 ;;  Problems
228 ;;
229 ;;     Uneven fold marks
230 ;;
231 ;;      Oops, I just deleted some text, and a fold mark got deleted!
232 ;;      What should I do?  Trust me, you will eventually do this
233 ;;      sometime. the easiest way is to open the buffer using
234 ;;      `folding-open-buffer' (C-c @ C-o) and add the fold mark by
235 ;;      hand. To find mismatching fold marks, the package `occur' is
236 ;;      useful. The command:
237 ;;
238 ;;          M-x occur RET {{{\|}}} RET
239 ;;
240 ;;      will extract all lines containing folding marks and present
241 ;;      them in a separate buffer.
242 ;;
243 ;;      Even though all folding marks are correct, Folding mode
244 ;;      sometimes gets confused, especially when entering and leaving
245 ;;      folds very often. To get it back on track, press C-g a few
246 ;;      times and give the command `folding-open-buffer' (C-c @ C-o).
247 ;;
248 ;;     Fold must have a label
249 ;;
250 ;;      When you make a fold, be sure to write some text for the name
251 ;;      of the fold, otherwise there may be an error "extraneous fold
252 ;;      mark..." Write like this:
253 ;;
254 ;;          ;;{{{ Note
255 ;;          ;;}}}
256 ;;
257 ;;      instead of
258 ;;
259 ;;          ;;{{{
260 ;;          ;;}}}
261 ;;
262 ;;     folding-whole-buffer doesn't fold whole buffer
263 ;;
264 ;;      If you call commands `folding-open-buffer' and
265 ;;      `folding-whole-buffer' and notice that there are open fold
266 ;;      sections in the buffer, then you have mismatch of folds
267 ;;      somewhere. Run ` M-x' `occur' and type regexp `{{{\|}}}' to
268 ;;      check where is the extra open or closing fold mark.
269 ;;
270 ;;  Folding and outline modes
271 ;;
272 ;;      Folding mode is not the same as Outline mode, a major and
273 ;;      minor mode which is part of the Emacs distribution. The two
274 ;;      packages do, however, resemble each other very much.  The main
275 ;;      differences between the two packages are:
276 ;;
277 ;;      o   Folding mode uses explicit marks, `{{{' and `}}}', to
278 ;;          mark the beginning and the end of a branch.
279 ;;          Outline, on the other other hand, tries to use already
280 ;;          existing marks, like the `\section' string in a TeX
281 ;;          document.
282 ;;
283 ;;      o   Outline mode has no end marker which means that it is
284 ;;          impossible for text to follow a sub-branch.
285 ;;
286 ;;      o   Folding mode use the same markers for branches on all depths,
287 ;;          Outline mode requires that marks should be longer the
288 ;;          further, down in the tree you go, e.g `\chap', \section',
289 ;;          `\subsection', `\subsubsection'. This is needed to
290 ;;          distinguish the next mark at the current or higher levels
291 ;;          from a sub-branch, a problem caused by the lack of
292 ;;          end-markers.
293 ;;
294 ;;      o   Folding mode has mouse support, you can navigate through a
295 ;;          folded document by clicking on fold marks. (The XEmacs version
296 ;;          of Outline mode has mouse support.)
297 ;;
298 ;;      o   The Isearch facilities of Folding is capable of
299 ;;          automatically to open folds. Under Outline, the the entire
300 ;;          document must be opened prior isearch.
301 ;;
302 ;;      In conclusion, Outline mode is useful when the document being
303 ;;      edited contains natural markers, like LaTeX. When writing code
304 ;;      natural markers are hard to find, except if you're happy with
305 ;;      one function per fold.
306 ;;
307 ;;  Future development ideas
308 ;;
309 ;;      The plan was from the beginning to rewrite the entire package.
310 ;;      Including replacing the core of the program, written using
311 ;;      old Emacs technology (selective display), and replace it with
312 ;;      modern equivalences, like overlays or text-properties for
313 ;;      Emacs and extents for XEmacs.
314 ;;
315 ;;      It is not likely that any of this will come true considering
316 ;;      the time required to rewrite the core of the package. Since
317 ;;      the package, in it's current state, is much more powerful than
318 ;;      the original, it would be appropriate to write such package
319 ;;      from scratch instead of doing surgery on this one.
320
321 ;;}}}
322
323 ;;{{{ Customization
324
325 ;;  Customization: general
326 ;;
327 ;;      The behavior of Folding mode is controlled mainly by a set of
328 ;;      Emacs Lisp variables. This section will discuss the most
329 ;;      useful ones, for more details please see the code. The
330 ;;      descriptions below assumes that you know a bit about how to
331 ;;      use simple Emacs Lisp and knows how to edit ~/.emacs, your
332 ;;      init file.
333 ;;
334 ;;  Customization: hooks
335 ;;
336 ;;      The normal procedure when customizing a package is to write a
337 ;;      function doing the customization. The function is then added
338 ;;      to a hook which is called at an appropriate time. (Please see
339 ;;      the example section below.)  The following hooks are
340 ;;      available:
341 ;;
342 ;;      o   `folding-mode-hook'
343 ;;           Called when folding mode is activated.
344 ;;      o   `<major mode>-folding-hook'
345 ;;           Called when starting folding mode in a buffer with major
346 ;;           mode set to <major mode>. (e.g. When editing C code
347 ;;           the hook `c-mode-folding-hook' is called.)
348 ;;      o   `folding-load-hook'
349 ;;           Called when folding mode is loaded into Emacs.
350 ;;
351 ;;  Customization: The Mouse
352 ;;
353 ;;      The variable `folding-behave-table' contains the actions which
354 ;;      should be performed when the user clicks on an open fold, a
355 ;;      closed fold etc.  For example, if you prefer to `enter' a fold
356 ;;      rather than `open' it you should rebind this variable.
357 ;;
358 ;;      The variable `folding-default-mouse-keys-function' contains
359 ;;      the name of the function used to bind your mouse keys. To use
360 ;;      your own mouse bindings, create a function, say
361 ;;      `my-folding-bind-mouse', and set this variable to it.
362 ;;
363 ;;  Customization: Keymaps
364 ;;
365 ;;      When Emacs 19.29 was released, the keymap was divided into
366 ;;      strict parts. (This division existed before, but a lot of
367 ;;      packages, even the ones delivered with Emacs, ignored them.)
368 ;;
369 ;;          C-c <letter>    -- Reserved for the users private keymap.
370 ;;          C-c C-<letter>  -- Major mode. (Some other keys are
371 ;;                             reserved as well.)
372 ;;          C-c <Punctuation Char> <Whatever>
373 ;;                          -- Reserved for minor modes.
374 ;;
375 ;;      The reason why `C-c@' was chosen as the default prefix is that
376 ;;      it is used by outline-minor-mode. It is not likely that few
377 ;;      people will try to use folding and outline at the same time.
378 ;;
379 ;;      However, old key bindings have been kept if possible.  The
380 ;;      variable `folding-default-keys-function' specifies which
381 ;;      function should be called to bind the keys. There are various
382 ;;      function to choose from how user can select the keybindings.
383 ;;      To use the old key bindings, add the following line to your
384 ;;      init file:
385 ;;
386 ;;          (setq folding-default-keys-function
387 ;;                'folding-bind-backward-compatible-keys)
388 ;;
389 ;;      To define keys similar to the keys used by Outline mode, use:
390 ;;
391 ;;          (setq folding-default-keys-function
392 ;;                'folding-bind-outline-compatible-keys)
393 ;;
394 ;;  Customization: adding new major modes
395 ;;
396 ;;      To add fold marks for a new major mode, use the function
397 ;;      `folding-add-to-marks-list'. The command also replaces
398 ;;      existing marks. An example:
399 ;;
400 ;;          (folding-add-to-marks-list
401 ;;           'c-mode "/* {{{ " "/* }}} */" " */" t)
402 ;;
403 ;;  Customization: ISearch
404 ;;
405 ;;      If you don't like the extension folding.el applies to isearch,
406 ;;      set the variable `folding-isearch-install' to nil before
407 ;;      loading this package.
408
409 ;;}}}
410 ;;{{{ Examples
411
412 ;;  Example: personal setup
413 ;;
414 ;;      To define your own key binding instead of using the standard
415 ;;      ones, you can do like this:
416 ;;
417 ;;           (setq folding-mode-prefix-key "\C-c")
418 ;;           ;;
419 ;;           (setq folding-default-keys-function
420 ;;               '(folding-bind-backward-compatible-keys))
421 ;;           ;;
422 ;;           (setq folding-load-hook 'my-folding-load-hook)
423 ;;
424 ;;
425 ;;           (defun my-folding-load-hook ()
426 ;;             "Folding setup."
427 ;;
428 ;;             (folding-install)  ;; just to be sure
429 ;;
430 ;;             ;; ............................................... markers ...
431 ;;
432 ;;             ;;  Change text-mode fold marks. Handy for quick
433 ;;             ;;  sh/perl/awk code
434 ;;
435 ;;             (defvar folding-mode-marks-alist nil)
436 ;;
437 ;;             (let* ((ptr (assq 'text-mode folding-mode-marks-alist)))
438 ;;               (setcdr ptr (list "# {{{" "# }}}")))
439 ;;
440 ;;             ;; ........................................ bindings ...
441 ;;
442 ;;             ;;  Put `folding-whole-buffer' and `folding-open-buffer'
443 ;;             ;;  close together.
444 ;;
445 ;;             (defvar folding-mode-prefix-map nil)
446 ;;
447 ;;             (define-key folding-mode-prefix-map "\C-w" nil)
448 ;;             (define-key folding-mode-prefix-map "\C-s"
449 ;;                         'folding-show-current-entry)
450 ;;             (define-key folding-mode-prefix-map "\C-p"
451 ;;                         'folding-whole-buffer))
452 ;;
453 ;;  Example: changing default fold marks
454 ;;
455 ;;      In case you're not happy with the default folding marks, you
456 ;;      can change them easily. Here is an example
457 ;;
458 ;;          (setq folding-load-hook 'my-folding-load-hook)
459 ;;
460 ;;          (defun my-folding-load-hook ()
461 ;;            "Folding vars setup."
462 ;;            ;;  Change marks for 'text-mode'
463 ;;            (let* ((ptr (assq 'text-mode folding-mode-marks-alist)))
464 ;;              (setcdr ptr (list "# {{{" "# }}}"))))
465 ;;
466 ;;  Example: choosing different fold marks for mode
467 ;;
468 ;;      Suppose you sometimes want to use different fold marks for the
469 ;;      major mode: e.g. to alternate between "# {{{" and "{{{" in
470 ;;      `text-mode' Call `M-x' `my-folding-text-mode-setup' to change
471 ;;      the marks.
472 ;;
473 ;;            (defun my-folding-text-mode-setup (&optional use-custom-folding-marks)
474 ;;              (interactive
475 ;;                (list (y-or-n-p "Use Custom fold marks now? ")))
476 ;;              (let* ((ptr (assq major-mode folding-mode-marks-alist))
477 ;;                     (default-begin "# {{{")
478 ;;                     (default-end   "# }}}")
479 ;;                     (begin "{{{")
480 ;;                     (end   "}}}"))
481 ;;                (when (eq major-mode 'text-mode)
482 ;;                  (unless use-custom-folding-marks
483 ;;                    (setq  begin default-begin  end default-end)))
484 ;;                (setcdr ptr (list begin end))
485 ;;                (folding-set-marks begin end)))
486 ;;
487 ;;  Example: AucTex setup
488 ;;
489 ;;      Suppose you're using comment.sty with AucTeX for editing
490 ;;      LaTeX2e documents and you have these comment types. You would
491 ;;      like to be able to set which of these 3 is to be folded at any
492 ;;      one time, using a simple key sequence: move back and forth
493 ;;      easily between the different comment types, e.g., "unfold
494 ;;      everything then fold on \x".
495 ;;
496 ;;          \O   ...  \endO
497 ;;          \L   ...  \endL
498 ;;          \B   ...  \endB
499 ;;
500 ;;          (setq folding-load-hook 'my-folding-load-hook)
501 ;;
502 ;;          (defun my-folding-load-hook ()
503 ;;            "Folding vars setup."
504 ;;            (let ((ptr (assq 'text-mode folding-mode-marks-alist)))
505 ;;              (setcdr ptr (list "\\O" "\\endO"))
506 ;;              (define-key folding-mode-prefix-map "C"
507 ;;                         'my-folding-marks-change)))
508 ;;
509 ;;          (defun my-folding-marks-change (&optional selection)
510 ;;            "Select folding marks: prefixes nil, C-u and C-u C-u."
511 ;;            (interactive "P")
512 ;;            (let ((ptr (assq major-mode folding-mode-marks-alist))
513 ;;                  input)
514 ;;              (when (string-match "^\\(plain-\\|la\\|auc\\)?tex-"
515 ;;                                  (symbol-name  major-mode))
516 ;;                (setq input
517 ;;                      (read-string "Latex \\end(X) Marker (default O): "
518 ;;                                   nil nil "O" nil))
519 ;;                (setq input (upcase input))
520 ;;                (turn-off-folding-mode)
521 ;;                (folding-add-to-marks-list
522 ;;                 major-mode
523 ;;                 (concat "\\" input) (concat "\\end" input) nil nil t)
524 ;;                ;; (setcdr ptr (list (concat "\\" input) (concat "\\end" input)))
525 ;;                (turn-on-folding-mode))))
526 ;;          ;;  End of example
527 ;;
528 ;;  Bugs: Lazy-shot.el conflict in XEmacs
529 ;;
530 ;;      [XEmacs 20.4 lazy-shot-mode]
531 ;;      1998-05-28 Reported by Solofo Ramangalahy <solofo A T mpi-sb mpg de>
532 ;;
533 ;;          % xemacs -q folding.el
534 ;;          M-x eval-buffer
535 ;;          M-x folding-mode
536 ;;          M-x font-lock-mode
537 ;;          M-x lazy-shot-mode
538 ;;          C-s mouse
539 ;;
540 ;;      then search for mouse again and again. At some point you will
541 ;;      see "Deleting extent" in the minibuffer and XEmacs freezes.
542 ;;
543 ;;      The strange point is that I have this bug only under Solaris
544 ;;      2.5 sparc (binaries from ftp.xemacs.org) but not under Solaris
545 ;;      2.6 x86. (XEmacs 20.4, folding 2.35). I will try to access
546 ;;      more machines to see if it's the same.
547 ;;
548 ;;      I suspect that the culprit is lazy-shot as it is beta, but
549 ;;      maybe you will be able to describe the bug more precisely to
550 ;;      the XEmacs people I you can reproduce it.
551
552 ;;}}}
553 ;;{{{ Old Documentation
554
555 ;;  Old documentation
556 ;;
557 ;;      The following text was written by Jamie Lokier for the release
558 ;;      of Folding V1.6. It is included here for no particular reason:
559 ;;
560 ;;      Emacs 18:
561 ;;      Folding mode has been tested with versions 18.55 and
562 ;;      18.58 of Emacs.
563 ;;
564 ;;      Epoch:
565 ;;      Folding mode has been tested on Epoch 4.0p2.
566 ;;
567 ;;      [X]Emacs:
568 ;;      There is code in here to handle some aspects of XEmacs.
569 ;;      However, up to version 19.6, there appears to be no way to
570 ;;      display folds. Selective-display does not work, and neither do
571 ;;      invisible extents, so Folding mode has no chance of
572 ;;      working. This is likely to change in future versions of
573 ;;      XEmacs.
574 ;;
575 ;;      Emacs 19:
576 ;;      Tested on version 19.8, appears to be fine. Minor bug:
577 ;;      display the buffer in several different frames, then move in
578 ;;      and out of folds in the buffer. The frames are automatically
579 ;;      moved to the top of the stacking order.
580 ;;
581 ;;      Some of the code is quite horrible, generally in order to
582 ;;      avoid some Emacs display "features". Some of it is specific to
583 ;;      certain versions of Emacs. By the time Emacs 19 is around and
584 ;;      everyone is using it, hopefully most of it won't be necessary.
585 ;;
586 ;;  More known bugs
587 ;;
588 ;;      *** Needs folding-fold-region to be more intelligent about
589 ;;      finding a good region. Check folding a whole current fold.
590 ;;
591 ;;      *** Now works with 19!  But check out what happens when you
592 ;;      exit a fold with the file displayed in two frames. Both
593 ;;      windows get fronted. Better fix that sometime.
594 ;;
595 ;;  Future features
596 ;;
597 ;;      *** I will add a `folding-next-error' sometime. It will only
598 ;;      work with Emacs versions later than 18.58, because compile.el
599 ;;      in earlier versions does not count line-numbers in the right
600 ;;      way, when selective display is active.
601 ;;
602 ;;      *** Fold titles should be optionally allowed on the closing
603 ;;      fold marks, and `folding-tidy-inside' should check that the
604 ;;      opening title matches the closing title.
605 ;;
606 ;;      *** `folded-file' set in the local variables at the end of a
607 ;;      file could encode the type of fold marks used in that file,
608 ;;      and other things, like the margins inside folds.
609 ;;
610 ;;      *** I can see a lot of use for the newer features of Emacs 19:
611 ;;
612 ;;      Using invisible text-properties (I hope they are intended to
613 ;;      make text invisible; it isn't implemented like that yet), it
614 ;;      will be possible to hide folded text without affecting the
615 ;;      text of the buffer. At the moment, Folding mode uses selective
616 ;;      display to hide text, which involves substituting
617 ;;      carriage-returns for line-feeds in the buffer. This isn't such
618 ;;      a good way. It may also be possible to display different folds
619 ;;      in different windows in Emacs 19.
620 ;;
621 ;;      Using even more text-properties, it may be possible to track
622 ;;      pointer movements in and out of folds, and have Folding mode
623 ;;      automatically enter or exit folds as necessary to maintain a
624 ;;      sensible display. Because the text itself is not modified (if
625 ;;      overlays are used to hide text), this is quite safe. It would
626 ;;      make it unnecessary to provide functions like
627 ;;      `folding-forward-char', `folding-goto-line' or
628 ;;      `folding-next-error', and things like I-search would
629 ;;      automatically move in and out of folds as necessary.
630 ;;
631 ;;      Yet more text-properties/overlays might make it possible to
632 ;;      avoid using narrowing. This might allow some major modes to
633 ;;      indent text properly, e.g., C++ mode.
634
635 ;;}}}
636
637 ;;; Change Log:
638
639 ;;{{{ History
640
641 ;; [person version] = developer and his revision tree number.
642 ;;
643 ;; Sep  20  2009  23.1             [jari git a80c2d6]
644 ;; - Remove 'defmacro custom' for very old Emacs version that did
645 ;;   not have custom.
646 ;; - Modernize all macros to use new backquote syntax,
647 ;; - Move `folding-narrow-by-default' variable
648 ;;   definition before `folding-advice-instantiate' which
649 ;;   refers to it.
650 ;;
651 ;; Feb  20  2009  22.2.1           [jari git 51ada03..56b3089]
652 ;; - Make XEmacs CVS and Savannah git revisions at header more clear
653 ;; - Unify html-mode folds as in other modes: change [[[ ]]] to {{{ }}}
654 ;;
655 ;; Feb  09  2009  22.2.1           [jari git e0c2e92..6a3cff7]
656 ;; - Minor documentaton fixes.
657 ;; - Add new `python-mode' using `folding-add-to-marks-list'.
658 ;; - Add new variable `folding-version-time' to record edit time.
659 ;;   Value is automatically updated by developer's Emacs setup.
660 ;;
661 ;; May  06  2007  21.4             [jari 3.38-3.41 2007.0506]
662 ;; - Cleanup. Eol whitespaces removed, extra newlines cleaned.
663 ;;   Paren positions corrected.
664 ;; - 'Personal reflections by Anders Lindgren' topic
665 ;;   rephrased 'Future development ideas'
666 ;; - (folding-show-current-entry): Run `font-lock-fontify-region'
667 ;;   after opening the fold. Font-lock.el treated all closed folds
668 ;;   as comments.
669 ;;
670 ;; Nov  16  2006  21.4             [jari 3.36-3.37 2006.1118]
671 ;; - Jeremy Hankins <nowan A T nowan org> sent a patch, which
672 ;;   adds variable `folding-narrow-by-default'. The patch affects
673 ;;   mostly `folding-shift-in'. This makes it possible to
674 ;;   advise viper-search to open folds. Thanks.
675 ;; - Added VCS URL header to the beginning for canonnical location.
676 ;;   Updated maintainer section.
677 ;; - Fixed Copyright years.
678 ;;
679 ;; Nov  25  2004  21.3             [jari 3.35 2004.1125]
680 ;; - non-ascii character removed from bibtex-mode.
681 ;;   Changed bib-mode '@comment' => '%'. Closes Debian
682 ;;   Bug#282388
683 ;;
684 ;; Sep  10  2004  21.3             [jari 2.116 2004.0910]
685 ;; - (folding-fold-region): caused to indent bottom fold
686 ;;   some 50 spaces forward in auctex:latex-mode. Disabled
687 ;;   running `indent-according-to-mode' while in latex-mode.
688 ;;   Bug reported by Uwe Brauer; oub A T mat dot ucm dot es
689 ;; - Removed extra newlines from whole buffer.
690 ;; - Changed version scheme to date based YYYY.MMDD
691 ;; - Removed unnecessary 'all rights reserved'.
692 ;; - (folding-check-folded): Added check for \r character, which
693 ;; - protected all email addresses by removing AT-signs.
694 ;;
695 ;; Apr  01  2004  21.3             [jari 2.111-2.115]
696 ;; - Merged in changes made by 2003-11-12  Adrian Aichner
697 ;;   from XEmacs tree 1.15; Typo fixes for docstrings and comments.
698 ;; - Returned to old bug and solved it in a better way (preserve region) by
699 ;;   using different expansion macros for XEmacs and Emacs.
700 ;;   See See http://list-archive.xemacs.org/xemacs-beta/199810/msg00039.html
701 ;; - (folding-forward-char-1): 2.112 Renamed.
702 ;;   Was `folding-forward-char'.
703 ;;   (folding-backward-char-1): 2.112 Renamed.
704 ;;   Was `folding-backward-char'.
705 ;;   (folding-forward-char-macro): 2.112 New. Fix XEmacs
706 ;;   region preservation with '_p' interactive spec.
707 ;;   (folding-backward-char-macro): 2.112 New. Fix XEmacs
708 ;;   region preservation with '_p' interactive spec.
709 ;;   (folding-interactive-spec-p): 2.112 New.
710 ;;
711 ;; Sep  11  2003  21.2             [jari 2.107-2.111]
712 ;; - Added new sections "Uninstallation" and "To read the manual".
713 ;;   M-x finder can invoke folding too provided that patch to
714 ;;   lisp-mnt.el and finder.el is installed. Sent patch to XEmacs and
715 ;;   Emacs developers.
716 ;; - Moved fold-mark ";;{{{ Introduction" after the Commentary:
717 ;;   tag to have it included in M-x finder-commentary.
718 ;; - If called like this: `folding-uninstall' and immediately
719 ;;   `folding-mode', the keybindings were not there any more. Added
720 ;;   call to `folding-install' in `folding-mode'.
721 ;; - Completely rewrote `folding-install'. It's now divided into
722 ;;   `folding-install-keymaps' and `folding-uninstall-keymaps'
723 ;; - Added support for `php-mode', `javascript-mode',
724 ;;   `change-log-mode' and `finder-mode'.
725 ;; - Documentation changes (fit all to 80 characters).
726 ;;
727 ;; Aug  21  2002  21.2             [jari 2.105-2.106]
728 ;; - Added user function `folding-uninstall'.
729 ;; - Removed `interactive' status: `folding-install-hooks' and
730 ;;   `folding-uninstall-hooks'
731 ;;
732 ;; Aug  02  2002  20.7             [jari 2.101-2.104]
733 ;; - Added font lock support. Now beginning and end markers are
734 ;;   highlighted with user variables `folding-font-lock-begin-mark'
735 ;;   `folding-font-lock-end-mark'. Feature suggested by
736 ;;   <Claude BOUCHER A T astrium-space com>
737 ;; - Removed LCD entry - unnecessary.
738 ;;
739 ;; Jan  24  2002  20.7             [jari 2.100]
740 ;; - (folding-context-next-action):New user function.
741 ;;   Code by Scott Evans <gse A T antisleep com>
742 ;; - (folding-bind-default-keys): Added
743 ;;   C-x . to run `folding-context-next-action'
744 ;; - (folding-mouse-call-original): Added `car-safe' to read
745 ;;   EVENT, which may be nil.
746 ;;
747 ;; Jul  31  2001  20.7             [jari 2.98-2.99]
748 ;; - Gleb Arshinov  <gleb A T barsook com> fixed the broken XEmacs
749 ;;   isearch support and sent nice patch.
750 ;;
751 ;; Jul  19  2001  20.7             [jari 2.92-2.97]
752 ;; - Beautified lisp code by removing parens that were alone.
753 ;; - XEmacs latex-mode fix. The folds were strangely indented too
754 ;;   far right. The cause was `indent-according-to-mode' which is
755 ;;   now disabled in latex. bug reported by
756 ;;   Uwe Brauer; oub A T maraton sim ucm es
757 ;; - 2.96 Erroneous `:' in `folding-mode-write-file'
758 ;;   when it should have been `;'. Bug reported by
759 ;;   Brand Michael; michael brand A T siemens com
760 ;;
761 ;; Apr  04  2001  20.7             [jari 2.89-2.91]
762 ;; - Small corrections to find-func.el::find-function-search-for-symbol
763 ;;   implementation.
764 ;;
765 ;; Mar  08  2001  20.6             [jari 2.88]
766 ;; - Dave Masterson <dmasters A T rational com> reported that jumping to a
767 ;;   url displayed by the C-h f FUNCTION which told where the function
768 ;;   was located died. The reason was that the buffer was folded and
769 ;;   find-func.el::find-function-search-for-symbol used regexps that
770 ;;   do not take into account folded buffers. The regexps used there
771 ;;   rely on syntax tables.
772 ;; - Added two new advices to catch find-func.el and unfold the buffer
773 ;;   prior searching: (advice find-file-noselect after) and (advice
774 ;;   find-function-search-for-symbol around)
775 ;;
776 ;; Mar  04  2001  20.6             [jari 2.83-2.87]
777 ;; - Added ###autoload statements, tidied up empty lines and lisp syntax.
778 ;; - Run checkdoc.el 0.6.1 and corrected errors.
779 ;;
780 ;; Jan  04  2001  20.6             [jari 2.82]
781 ;; - Added FOLD highlight feature for XEmacs:
782 ;;   `folding-mode-motion-highlight-fold'
783 ;;   and package `mode-motion' Suggested by
784 ;;   Thomas Ruhnau <thomas ruhnau A T intermetall de>
785 ;; - (folding-bind-default-keys): 2.81 New binding C-k
786 ;;   `folding-marks-kill'
787 ;;   (fold-marks-kill): 2.81 New.
788 ;;
789 ;; Jan  03  2001  20.6             [jari 2.81]
790 ;; - (folding-folding-region): 2.80 Renamed to `folding-fold-region'
791 ;; - (folding-mark-look-at-top-mark-p): 2.80 New.
792 ;; - (folding-mark-look-at-bottom-mark-p): 2.80 New.
793 ;; - (folding-tidy-inside): 2.80 Use `folding-mark-look-at-top-mark-p'
794 ;;   and `folding-mark-look-at-bottom-mark-p'.
795 ;; - Didn't accept spaces in front of fold markers.
796 ;; - (folding-fold-region): 2.80 Added `indent-according-to-mode'
797 ;;   to indent folds as needed.
798 ;;
799 ;; Dec  16  2000  20.6             [jari 2.79-2.80]
800 ;; - `folding-xemacs-p' now test (featurep 'xemacs)
801 ;; - Added missing folding functions to the menubar
802 ;; - `folding-package-url-location' new variable used by function
803 ;;   `folding-insert-advertise-folding-mode'
804 ;; - `folding-keep-hooked' was commented out in `folding-mode'. Added
805 ;;   back.
806 ;;
807 ;; Jul  25  2000  20.6             [jari 2.76-2.78]
808 ;; - 2.75 Added support for modes:
809 ;;   xrdb-mode, ksh-mode and sql-mode contributed by
810 ;;   Juhapekka Tolvanen <juhtolv A T st jyu fi>. Scanned systematically
811 ;;   all modes under Emacs 20.6 progmodes and added support for:
812 ;;   ada-mode, asm-mode, awk-mode, cperl-mode, fortran-mode, f90-mode,
813 ;;   icon-mode, m4-mode, meta-mode, pascal-mode, prolog-mode,
814 ;;   simula-mode, vhdl-mode, bibtex-mode, nroff-mode, scribe-mode(*),
815 ;;   sgml-mode
816 ;; - Mode marked with (*) was not added.
817 ;; - (folding-insert-advertise-folding-mode): 2.76 New. Suggested by
818 ;;   Juhapekka Tolvanen <juhtolv A T st jyu fi>
819 ;; - (folding-bind-default-keys): 2.76
820 ;;   folding-insert-advertise-folding-mode Bound to key "I"
821 ;;
822 ;; Apr  24  1999  20.4             [jari 2.73-2.75]
823 ;; - (folding-bind-terminal-keys): 2.74 New.  Bind C-f and C-b only at
824 ;;   non-window system where they are really needed.  Someone may use
825 ;;   C-f for `isearch-forward' in windowed Emacs.
826 ;; - (folding-bind-default-keys): 2.74 Use `folding-bind-terminal-keys'
827 ;; - (folding-bind-outline-compatible-keys): 2.74
828 ;;   Use `folding-bind-terminal-keys'
829 ;;
830 ;; Feb  13  1999  20.4             [jari 2.71-2.72]
831 ;; - (folding-event-posn): 2.70 Wrong
832 ;;   place of paren and the following was malformed call:
833 ;;   (let* ((el (funcall (symbol-function 'event-start) event)))
834 ;;
835 ;; Jan  13  1999  20.4             [jari 2.70]
836 ;; - 2.69 The `looking-at' is now smarter with
837 ;;   fold beginning marks. The tradition has been the the fold always
838 ;;   has a name, so the requirement to search fold is "{{{ ". Now
839 ;;   the " " is searched as " *", not requiring a space --> not requiring
840 ;;   a fold name.
841 ;; - (folding-skip-folds): >>feature not not enabled<<
842 ;;   2.69 Do not require trailing " " any more.'
843 ;;   (folding-tidy-inside): >>feature not not enabled<<
844 ;;   2.69 Do not require trailing " " any more.
845 ;; - (folding-install): 2.69 Fixed indentation.
846 ;; - (folding-mark-look-at): 2.69 The "em" missed "*" and thus pressing
847 ;;   mouse-3 at the end-fold didn't collapse the whole fold.
848 ;;
849 ;; Jan  12  1999  20.4             [jari 2.69]
850 ;;   (folding-bind-default-mouse): 2.68
851 ;;   XEmacs and Emacs Mouse binding was different. Now use common
852 ;;   bindings: The S-mouse-2 was superfluous, because mouse-3 already
853 ;;   did that, so the binding was removed.
854 ;;   mouse-3     folding-mouse-context-sensitive
855 ;;   S-mouse-2   folding-hide-current-entry
856 ;;   C-S-mouse-2 folding-mouse-pick-move
857 ;;
858 ;;;; Jan  09  1999  20.4             [jari 2.67-2.68]
859 ;; - (folding-event-posn): 2.66 Hide `event-start' From XEmacs
860 ;;   (byte compile silencer)
861 ;;
862 ;; Jan  07  1999  20.4             [jari 2.65-2.66]
863 ;; - The Folding begin and AND mark was not case sensitive;
864 ;;   that's why a latex styles "\B" and "\endB" fold marks couldn't
865 ;;   be used. Added relevant `case-fold-search' settings. Not tested
866 ;;   very well, though.
867 ;; - Added standard "turn-on" "turn-off" functions.
868 ;; - (folding-whole-buffer): 2.65 Better
869 ;;   Error message. Show used folding-mark on error.
870 ;; - (folding-skip-folds): 2.65 Moved docs in function.
871 ;; - (turn-off-folding-mode): 2.65 New.
872 ;; - (turn-on-folding-mode): 2.65 New.
873 ;; - (folding-mark-look-at): 2.65 `case-fold-search'
874 ;; - (folding-next-visible-heading): 2.65 `case-fold-search'
875 ;; - (folding-find-folding-mark): 2.65 `case-fold-search'
876 ;; - (folding-pick-move): 2.65 `case-fold-search'
877 ;; - (folding-skip-folds): 2.65 `case-fold-search'
878 ;; - (folding-tidy-inside): 2.65 `case-fold-search'
879 ;; - (folding-convert-to-major-folds): 2.65 `case-fold-search'
880 ;;
881 ;;  Jan  04  1999  20.4             [jari 2.62-2.64]
882 ;; - (folding-set-local-variables): 2.61 New. Now it is possible to
883 ;;   change the folding marks dynamically.
884 ;; - (folding-mode): 2.61 Call `folding-set-local-variables'
885 ;;   (folding-mode-marks-alist): 2.61 mention
886 ;; - `folding-set-local-variables'
887 ;;   Added documentation section: "Example: AucTex setup"
888 ;; - NT Emacs fix wrapped inside `eval-and-compile'. hs-discard-overlays
889 ;;   are now hidden from byte compiler (since the code is not
890 ;;   executed anyway)
891 ;;
892 ;; May  24  1999  19.34             [jari 2.59-2.61]
893 ;; - New function `folding-all-comment-blocks-in-region'. Requested by
894 ;;   Uwe Brauer <oub A T eucmos sim ucm es>. Bound under "/" key.
895 ;; - (folding-all-comment-blocks-in-region):
896 ;;   Check non-whitespace `comment-end'. Added `matlab-mode' to
897 ;;   fold list
898 ;; - (folding-event-posn): 2.63 Got rid of the XEmacs/Emacs
899 ;;   posn-/event- byte compiler warnings
900 ;; - (folding-mouse-call-original): 2.63 Got rid of the XEmacs
901 ;;   `event-button' byte compiler warning.
902 ;;
903 ;; Apr  15  1999  19.34             [jari 2.57]
904 ;; - (folding-mouse-call-original): Samuel Mikes
905 ;;   <smikes A T alumni hmc edu> reported that the `concat' function was
906 ;;   used to add an integer to "button" event.  Applied patch to use
907 ;;   `format' instead.
908 ;;
909 ;; Mar  03  1999  19.34             [andersl]
910 ;;  - (folding-install): had extra paren. Removed.
911 ;;
912 ;; Feb  22  1999  19.34             [jari 2.56]
913 ;;  - folding-install):
914 ;;    Check if `folding-mode-prefix-map' is nil and call
915 ;;
916 ;; Feb  19  1999  19.34             [jari 2.55]
917 ;;  - (folding-mode-hook-no-re):
918 ;;    Renamed to `folding-mode-hook-no-regexp'
919 ;;  - (fold-inside-mode-name): Renames to `folding-inside-mode-name'
920 ;;    (fold-mode-string): Renamed to `folding-mode-string'
921 ;;  - Renamed all `fold-' prefixes to `folding-'
922 ;;  - Rewrote chapter `Example: personal setup'
923 ;;
924 ;; Jan  01  1999  19.34             [jari 2.54]
925 ;; - Byte compiler error fix: (folding-bind-outline-compatible-keys):
926 ;;   'folding-show-all lacked the quote.
927 ;;
928 ;; Dec  30  1998  19.34             [jari 2.53]
929 ;; - Jesper Pedersen <blackie A T imada ou dk> reported bug that hiding
930 ;;   subtree was broken. This turned out to be a bigger problem in fold
931 ;;   handling in general. This release has big relatively big error
932 ;;   fixes.
933 ;; - Many of the folding functions were also renamed to mimic Emacs 20.3
934 ;;   allout.el names. Outline keybindings were rewritten too.
935 ;; - folding.el (folding-mouse-yank-at-point): Renamed from
936 ;;   `folding-mouse-operate-at-point'. The name is similar to Emacs
937 ;;   standard variable name. The default value changed from nil --> t
938 ;;   according to suggestion by Jesper Pedersen <blackie A T  imada ou dk>
939 ;;   Message "Info, Ignore [X]Emacs specific..." is now displayed only
940 ;;   while byte compiling file.
941 ;;   (folding-bind-outline-compatible-keys):
942 ;;   Checked the Emacs 20.3 allout.el outline bindings and made
943 ;;   folding mimic them
944 ;;   (folding-show-subtree): Renamed to `folding-show-current-subtree'
945 ;;   according to allout.el
946 ;;   (folding-hide-subtree): Renamed to `folding-hide-current-subtree'
947 ;;   according to allout.el
948 ;;   (folding-enter): Renamed to `folding-shift-in'
949 ;;   according to allout.el
950 ;;   (folding-exit): Renamed to `folding-shift-out'
951 ;;   according to allout.el
952 ;;   (folding-move-up): Renamed to `folding-previous-visible-heading'
953 ;;   according to allout.el
954 ;;   (folding-move): Renamed to `folding-next-visible-heading'
955 ;;   according to allout.el
956 ;;   (folding-top-level): Renamed to `folding-show-all'
957 ;;   according to allout.el
958 ;;   (folding-show): Renamed to `folding-show-current-entry'
959 ;;   according to allout.el
960 ;;   (folding-hide): Renamed to `folding-hide-current-entry'
961 ;;   according to allout.el
962 ;;   (folding-region-open-close): While loop rewritten so that if user
963 ;;   is already on a fold mark, then close current fold. This also
964 ;;   fixed the show/hide subtree problem.
965 ;;   (folding-hide-current-subtree): If use hide subtree that only had
966 ;;   one fold, then calling this function caused error. The reason was
967 ;;   error in `folding-pick-move' (folding-pick-move): Test that
968 ;;   `moved' variable is integer and only then move point. This is the
969 ;;   status indicator from `folding-find-folding-mark'
970 ;;   (folding-find-folding-mark): Fixed. mistakenly moved point when
971 ;;   checking TOP level marker, status 11. the point was permanently
972 ;;   moved to point-min.
973 ;;
974 ;; Dec  29  1998  19.34             [jari 2.51]
975 ;; - Jesper Pedersen <blackie A T imada ou dk> reported that prefix key
976 ;;   cannot take vector notation [(key)]. This required changing the way
977 ;;   how folding maps the keys. Now uses intermediate keymap
978 ;;   `folding-mode-prefix-map'
979 ;; - `folding-kbd' is new.
980 ;; - `folding-mode' function description has better layout.
981 ;; - `folding-get-mode-marks' is now defsubst.
982 ;;
983 ;; Dec  13  1998  19.34             [jari 2.49-2.50]
984 ;; - Gleb Arshinov <gleb A T CS Stanford EDU> reported that the XEmacs 21.0
985 ;;   `concat' function won't accept integer argument any more and
986 ;;   provided patch for `folding-set-mode-line'.
987 ;;
988 ;; Nov  28  1998  19.34             [jari 2.49-2.50]
989 ;; - Gleb Arshinov <gleb A T CS Stanford EDU> reported that the
990 ;;   zmacs-region-stays must not be set globally but in the functions
991 ;;   that need it. He tested the change on tested on XEmacs 21.0 beta
992 ;;   and FSF Emacs 19.34.6 on NT and sent a patch . Thank you.
993 ;; - (folding-preserve-active-region): New macro to set
994 ;;   `zmacs-region-stays' to t in XEmacs.
995 ;; - (folding-forward-char): Use `folding-preserve-active-region'
996 ;; - (folding-backward-char): Use `folding-preserve-active-region'
997 ;; - (folding-end-of-line):  Use `folding-preserve-active-region'
998 ;; - (folding-isearch-general): Variables `is-fold' and
999 ;;   `is narrowed' removed, because they were not used. (Byte
1000 ;;   Compilation fix)
1001 ;; - Later: interestingly using `defmacro'
1002 ;;   folding-preserve-active-region does not work in XEmacs 21.0 beta,
1003 ;;   but `defsubst' does. Reported and corrected by Gleb.
1004 ;;
1005 ;; Oct  22  1998  19.34             [jari 2.47-2.48]
1006 ;; - NT Emacs has had long time a bug where it strips away ^M when
1007 ;;   closed fold is copied to kill ring. When pasted, then ^M are
1008 ;;   gone. This cover NT Emacs releases 19.34 - 20.3. Bug report has
1009 ;;   been filed.
1010 ;; - to cope with the situation I added new advice functions that
1011 ;;   get instantiated only for these versions of NT Emacs. See
1012 ;;   `kill-new' and `current-kill'
1013 ;;
1014 ;; Oct  21  1998  19.34             [jari 2.46]
1015 ;; - `folding-isearch-general' now enters folds as usual with isearch.
1016 ;;   The only test needed was to check `quit-isearch' before calling
1017 ;;   `folding-goto-char', because the narrow case was already taken
1018 ;;   cared of in the condition case.
1019 ;;
1020 ;; Oct  19  1998  19.34             [jari 2.44]
1021 ;; -  1998-10-19 Uwe Brauer <oub A T sunma4 mat ucm es> reported that
1022 ;;    In Netscape version > 4 the {{{ marks cannot be used. For IE they
1023 ;;    were fine, but not for Netscape. Some bug there.
1024 ;;    --> Marks changed to [[[ ]]]
1025 ;;
1026 ;; Oct  5  1998  19.34             [jari 2.43]
1027 ;; - The "_p" flag does not exist in Emacs 19.34, so the previous patch
1028 ;;   was removed. <greg A T alphatech com> (Greg Klanderman) suggested using
1029 ;;   `zmacs-region-stays'. Added to the beginning of file.
1030 ;; - todo: folding does not seem to open folds any more with Isearch.
1031 ;;
1032 ;; Oct  5  1998  19.34             [jari 2.42]
1033 ;; - Gleb Arshinov <gleb A T cs stanford edu> reported (and supplied patch):
1034 ;;   I am using the latest beta of folding.el with XEmacs 21.0 "Finnish
1035 ;;   Landrace" [Lucid] (i386-pc-win32) (same bug is present with folding.el
1036 ;;   included with XEmacs). Being a big fan of zmacs-region, I was
1037 ;;   disappointed to find that folding mode caused my usual way of
1038 ;;   selecting regions (e.g. to select a line C-space, C-a, C-e) to break
1039 ;;   :( I discovered that the following 3 functions would unset my mark.
1040 ;;   Upon reading some documentation, this seems to be caused by an
1041 ;;   argument to interactive used by these functions. With the following
1042 ;;   tiny patch, the undesirable behaviour is gone.
1043 ;; - Patch was applied as is. Function affected:
1044 ;;   `folding-forward-char' `folding-backward-char'
1045 ;;   `folding-end-of-line'. Interactive spec changed from "p" to "_p"
1046 ;;
1047 ;; Sep 28  1998  19.34             [jari 2.41]
1048 ;; - Wrote section "folding-whole-buffer doesn't fold whole buffer" to
1049 ;;   Problems topic. Fixed some indentation in documentation so that
1050 ;;   command  ripdoc.pl folding.el | t2html.pl --simple > folding.html
1051 ;;   works properly.
1052 ;;
1053 ;; Sep 24  1998  19.34             [jari 2.40]
1054 ;; - Stephen Smith <steve A T fmrib ox ac uk> wished that the
1055 ;;   `folding-comment-fold' should handle modes that have comment-start
1056 ;;   and comment-end too. That lead to rewriting the comment function so
1057 ;;   that it can be adapted to new modes.
1058 ;; - `folding-pick-move' didn't work in C-mode. Fixed.
1059 ;;    (folding-find-folding-mark):
1060 ;;    m and re must be protected with `regexp-quote'. This
1061 ;;    corrected error eg. in C-mode where `folding-pick-move'
1062 ;;    didn't move at all.
1063 ;;    (folding-comment-fold): Added support for major modes that
1064 ;;    have `comment-start' and `comment-end'. Use
1065 ;;    `folding-comment-folding-table'
1066 ;;    (folding-comment-c-mode): New.
1067 ;;    (folding-uncomment-c-mode): New.
1068 ;;    (folding-comment-folding-table): New. To adapt to any major-mode.
1069 ;;    (folding-uncomment-mode-generic): New.
1070 ;;    (folding-comment-mode-generic): New.
1071 ;;
1072 ;; Aug 08  1998  19.34             [jari 2.39]
1073 ;; - Andrew Maccormack <andrewm A T bristol st com> reported that the
1074 ;;   `em' end marker that was defined in the `let' should also have
1075 ;;   `[ \t\n]' which is in par with the `bm'. This way fold markers do
1076 ;;   not need to be parked to the left any more.
1077 ;;
1078 ;; Jun 05  1998  19.34             [jari 2.37-2.38]
1079 ;; - Alf-Ivar Holm <affi A T osc no> send functions
1080 ;;   `folding-toggle-enter-exit' and `folding-toggle-show-hide' which
1081 ;;   were integrated. Alf also suggested that Fold marks should now
1082 ;;   necessarily be located at the beginning of line, but allow spaces
1083 ;;   at front. The patch was applied to `folding-mark-look-at'
1084 ;;
1085 ;; Mar 17  1998  19.34             [Anders]
1086 ;; - Anders: This patch fixes one problem that was reported in the
1087 ;;   beginning of May by Ryszard Kubiak <R Kubia A T ipipan gda pl>.
1088 ;; - Finally, I think that I have gotten mouse-context-sensitive
1089 ;;   right.  Now, when you click on a fold that fold rather than the
1090 ;;   one the cursor is on is used, while still not breaking commands
1091 ;;   like `mouse-save-then-kill' which assumes that the point hasn't
1092 ;;   been moved.
1093 ;; - Jari: Added topic "Fold must have a label" to the Problem section.
1094 ;;   as reported by Solofo Ramangalahy <solofo A T mpi-sb mpg de>
1095 ;; - 1998-05-04 Ryszard Kubiak <R Kubiak A T ipipan gda pl> reported: I am
1096 ;;   just curious if it is possible to make Emacs' cursor
1097 ;;   automatically follow a mouse-click on the {{{ and }}} lines. I
1098 ;;   mean by this that a [S-mouse-3] (as defined in my settings below
1099 ;;   --- I keep not liking overloading [mouse-3]) first moves the
1100 ;;   cursor to where the click happened and then hides or shows a
1101 ;;   folded area. I presume that i can write a two-lines long
1102 ;;   interactive function to do this. Still, may be this kind of mouse
1103 ;;   behaviour is already available.
1104 ;;
1105 ;; Mar 17  1998  19.34             [Jari 2.34-2.35]
1106 ;; - Added "Example: choosing different fold marks for mode"
1107 ;; - corrected `my-folding-text-mode-setup' example.
1108 ;;
1109 ;; Mar 10  1998  19.34             [Jari 2.32-2.33]
1110 ;; - [Anders] responds to mouse-3 handling problem: I have found the
1111 ;;   cause of the problem, and I have a suggestion for a fix.
1112 ;;
1113 ;;   The problem is caused by two things:
1114 ;;    * The "mouse-save-then-kill" checks that the previous command also
1115 ;;      was "mouse-save-then-kill".
1116 ;;
1117 ;;    * The second (more severe) problem is that
1118 ;;     "folding-mouse-context-sensitive" sets the point to the
1119 ;;     location of the click, effectively making
1120 ;;     "mouse-save-then-kill" mark the area between the point and the
1121 ;;     point! (This is why no region appears.)
1122 ;;
1123 ;;   The first problem can be easily fixed by setting "this-command"
1124 ;;   in "folding-mouse-call-original":
1125 ;;
1126 ;; -  Now the good old mouse-3 binding is back again.
1127 ;; - (folding-mouse-context-sensitive): Added `save-excursion' as
1128 ;;   Anders suggested before setting `state'.
1129 ;;   (folding-mouse-call-original): commented out experimental code and
1130 ;;   used (setq this-command orig-func) as Anders suggested.
1131 ;;
1132 ;; Mar 10  1998  19.34             [Jari 2.31]
1133 ;; - (folding-act): Added `event' to `folding-behave-table' calls.
1134 ;;   Input argument takes now `event' too
1135 ;; - (folding-mouse-context-sensitive): Added argument `event'
1136 ;; - (folding-mouse-call-original): Added  (this-command orig-func)
1137 ;;   when calling original command.
1138 ;; - (folding-bind-default-mouse): Changed mouse bindings. The
1139 ;;   button-3 can't be mapped by folding, because folding is unable to
1140 ;;   call the original function `mouse-save-then-kill'. Passing simple
1141 ;;   element to `mouse-save-then-kill' won't do the job. Eg if I
1142 ;;   (clicked mouse-1) moved mouse pointer to place X and pressed
1143 ;;   mouse-3, the area was not highlighted in folding mode. If folding
1144 ;;   mode was off the are was highlighted. I traced the
1145 ;;   `folding-mouse-call-original' and it was passing exactly the same
1146 ;;   event as without folding mode. I have no clue what to do about
1147 ;;   it...That's why I removed default mouse-3 binding and left it to
1148 ;;   emacs. This bug was reported by Ryszard Kubiak"
1149 ;;   <R Kubiak A T ipipan gda pl>
1150 ;;
1151 ;; Feb 12  1998  19.34             [Jari 2.30]
1152 ;; - (html-mode): New mode added to `folding-mode-marks-alist'
1153 ;; - (folding-get-mode-marks): Rewritten, now return 3rd element too.
1154 ;; - (folding-comment-fold): Added note that function with `comment-end'
1155 ;;   is not supported. Function will flag error in those cases.
1156 ;; - (folding-convert-to-major-folds): Conversion failed if eg; you
1157 ;;   switched between modes that has 2 and 1 comments, like
1158 ;;   /* */ (C) and //(C++). Now the conversion is bit smarter, but it's
1159 ;;   impossible to convert from /* */ to // directly because we don't
1160 ;;   know how to remove */ mark, you see:
1161 ;;
1162 ;;   Original mode was C
1163 ;;
1164 ;;      /* {{{ */
1165 ;;
1166 ;;   And now used changed it to C++ mode, and ran command
1167 ;;   `folding-convert-to-major-folds'. We no longer have information
1168 ;;   about old mode's beginning or end comment markers, so we only
1169 ;;   can convert the folds to format
1170 ;;
1171 ;;     // {{{ */
1172 ;;
1173 ;;   Where the ending comment mark from old mode is left there.
1174 ;;   This is slightly imperfect situation, but at least the fold
1175 ;;   conversion works.
1176 ;;
1177 ;; Jan 28  1998  19.34             [Jari 2.25-2.29]
1178 ;; - Added `generic-mode' to fold list, suggested by Wayne Adams
1179 ;;   <wadams A T galaxy sps mot com>
1180 ;; - Finally rewrote the awesome menu-bar code: now uses standard
1181 ;;   easy-menu Which works in both XEmacs and Emacs. The menu is no
1182 ;;   longer under "Tools", but appear when minor mode is turned on.
1183 ;; - Radical changes: Decided to remove all old lucid and epoch
1184 ;;   dependencies.  Lot of code removed and reprogrammed.
1185 ;; - I also got rid of the `folding-has-minor-mode-map-alist-p' variable
1186 ;;   and old 18.xx function `folding-merge-keymaps'.
1187 ;; - Symbol's value as variable is void ((folding-xemacs-p)) error fixed.
1188 ;; - Optimized 60 `folding-use-overlays-p' calls to only 4 within
1189 ;;   `folding-subst-regions'. (Used elp.el). It seems that half of the
1190 ;;   time is spent in the function `folding-narrow-to-region'
1191 ;;   function. Could it be optimized somehow?
1192 ;; - Changed "lucid" tests to `folding-xemacs-p' variable tests.
1193 ;; - Removed `folding-hack' and print message 'Info, ignore missing
1194 ;;   functions.."  instead. It's better that we see the missing
1195 ;;   functions and not define dummy hacks for them.
1196 ;;
1197 ;; Nov 13  1997  19.34             [Jari 2.18-2.24]
1198 ;; - Added tcl-mode  fold marks, suggested by  Petteri Kettunen
1199 ;;   <Petteri Kettunen A T oulu fi>
1200 ;; - Removed some old code and modified the hook functions a bit.
1201 ;; - Added new user function `folding-convert-to-major-folds', key "%".
1202 ;; - Added missing items to Emacs menubar, didn't dare to touch the
1203 ;;   XEmacs part.
1204 ;; - `folding-comment-fold': Small fix. commenting didn't work on
1205 ;;   closed folds.  or if point was on topmost fold.
1206 ;; - Added `folding-advice-instantiate' And corrected byte compiler
1207 ;;   message: Warning: variable oldposn bound but not referenced
1208 ;;   Warning: reference to free variable folding-stack
1209 ;; - updated (require 'custom) code
1210 ;;
1211 ;; Nov 6  1997  19.34             [Jari 2.17]
1212 ;; - Uwe Brauer <oub A T sunma4 mat ucm es> used folding for Latex files
1213 ;;   and he wished a feature that would allow him to comment away ext
1214 ;;   that was inside fold; when compiling the TeX file.
1215 ;; - Added new user function `folding-comment-fold'. And new
1216 ;;   keybinding ";".
1217 ;;
1218 ;; Oct 8  1997  19.34             [Jari 2.16]
1219 ;; - Now the minor mode map is always re-installed when this file is
1220 ;;   loaded.  If user accidentally made mistake in
1221 ;;   `folding-default-keys-function', he can simply try again and
1222 ;;   reload this file to have the new key definitions.
1223 ;; - Previously user had to manually go and delete the previous map
1224 ;;   from the `minor-mode-map-alist' before he could try again.
1225 ;;
1226 ;; Sep 29 1997  19.34             [Jari 2.14-2.15]
1227 ;; - Robert Marshall <rxmarsha A T bechtel com> Sent enhancement to goto-line
1228 ;;   code. Now M-g works more intuitively.
1229 ;; - Reformatted totally the documentation so that it can be ripped to
1230 ;;   html with jari's ema-doc.pls and t2html.pls Perl scripts.
1231 ;; - Run through checkdoc.el 1.55 and Elint 1.10 and corrected code.
1232 ;; - Added defcustom support. (not tested)
1233 ;;
1234 ;; Sep 19 1997  19.28             [Jari 2.13]
1235 ;; - Robert Marshall <rxmarsha A T bechtel com> Sent small correction to
1236 ;;   overlay code, where the 'owner tag was set wrong.
1237 ;;
1238 ;; Aug 14 1997  19.28             [Jari 2.12 ]
1239 ;; - A small regexp bug (extra whitespace was required after closing
1240 ;;   fold) cause failing of folding-convert-buffer-for-printing in the
1241 ;;   following situation
1242 ;; - Reported by Guide. Fixed now.
1243 ;;
1244 ;;   {{{ Main topic
1245 ;;   {{{ Subsection
1246 ;;   }}}               << no space or end tag here!
1247 ;;   }}} Main topic
1248 ;;
1249 ;; Aug 14 1997  19.28             [Jari 2.11]
1250 ;; - Guide Van Hoecke <Guido Van Hoecke A T bigfoot com> reported that
1251 ;;   he was using closing text for fold like:
1252 ;;
1253 ;;   {{{ Main topic
1254 ;;   {{{ Subsection
1255 ;;   }}} Subsection
1256 ;;   }}} Main topic
1257 ;;
1258 ;;   And when he did folding-convert-buffer-for-printing, it couldn't
1259 ;;   remove those closing marks but threw an error. I modified the
1260 ;;   function so that the regexp accepts anything after closing fold.
1261 ;;
1262 ;; Apr 18 1997  19.28             [Jari 2.10]
1263 ;; - Corrected function folding-show-current-subtree, which didn't
1264 ;;   find the correct end region, because folding-pick-move needed
1265 ;;   point at the top of beginning fold. Bug was reported by Uwe
1266 ;;   Brauer <oub A T sunma4 mat ucm es> Also changed folding-mark-look-at,
1267 ;;   which now has new call parameter 'move.
1268 ;;
1269 ;; Mar 22 1997  19.28             [Jari 2.9]
1270 ;; - Made the XEmacs20 match more stricter, so that
1271 ;;   folding-emacs-version gets value 'XEmacs19. Also added note about
1272 ;;   folding in WinNT in the compatibility section.
1273 ;; - Added sh-script-mode indented-text-mode folding marks.
1274 ;; - Moved the version from branch to the root, because the extra
1275 ;;   overlay code added, seems to be behaving well and it didn't break
1276 ;;   the existing functionality.
1277 ;;
1278 ;; Feb 17 1997  19.28             [Jari 2.8.1.2]
1279 ;; - Cleaned up Dan's changes. First: we must not replace the
1280 ;;   selective display code, but offer these two choices: Added
1281 ;;   folding-use-overlays-p function which looks variable
1282 ;;   folding-allow-overlays.
1283 ;; - Dan uses function from another Emacs specific (19.34+?) package
1284 ;;   hs-discard-overlays. This is not available in 19.28. it should
1285 ;;   be replaced with some new function... I didn't do that yet.
1286 ;; - The overlays don't exist in XEmacs. XE19.15 has promises: at least
1287 ;;   I have heard that they have overlay.el library to mimic Emacs
1288 ;;   functions.
1289 ;; - Now the overlay support can be turned on by setting
1290 ;;   folding-allow-overlays to non-nil. The default is to use selective
1291 ;;   display. Overlay Code is not tested!
1292 ;;
1293 ;; Feb 17 1997  19.28             [Dan  2.8.1.1]
1294 ;; - Dan Nicolaescu <done A T ece arizona edu> sent patch that replaced
1295 ;;   selective display code with overlays.
1296 ;;
1297 ;; Feb 10 1997  19.28             [jari 2.8]
1298 ;; - Ricardo Marek <ricky A T ornet co il> Kindly sent patch that
1299 ;;   makes code XEmacs 20.0 compatible. Thank you.
1300 ;;
1301 ;; Nov 7  1996  19.28             [jari 2.7]
1302 ;; - When I was on picture-mode and turned on folding, and started
1303 ;;   isearch (I don't remember how I got fold mode on exactly) it
1304 ;;   gave error that the fold marks were not defined and emacs
1305 ;;   locked up due to simultaneous isearch-loop
1306 ;; - Added few fixes to the isearch handling function to avoid
1307 ;;   infinite error loops.
1308 ;;
1309 ;; Nov 6 1996  19.28              [jari 2.5 - 2.6]
1310 ;; - Situation: have folded buffer, manually _narrow_ somewhere, C-x n n
1311 ;; - Then try searching --> folding breaks. Now it checks if the
1312 ;;   region is true narrow and not folding-narrow before trying
1313 ;;   to go outside of region and open a fold
1314 ;; - If it's true narrow, then we stay in that narrowed region.
1315 ;;
1316 ;;   folding-isearch-general               :+
1317 ;;   folding-region-has-folding-marks-p       :+
1318 ;;
1319 ;; Oct 23 1996  19.28             [jari 2.4]
1320 ;;   folding-display-name                  :+ new user cmd "C-n"
1321 ;;   folding-find-folding-mark             :+ new
1322 ;;   folding-pick-move                     :! rewritten, full of bugs
1323 ;;   folding-region-open-close             :! rewritten, full of bugs
1324 ;;
1325 ;; Oct 22 1996  19.28             [jari 2.3]
1326 ;; - folding-pick-move                     :! rewritten
1327 ;;   folding-region-open-close             :+ new user cmd "#"
1328 ;;   folding-show-current-subtree          :+ new user cmd "C-s", hides too
1329 ;;
1330 ;; Aug 01 1996  19.31             [andersl]
1331 ;; - folding-subst-regions, variable `font-lock-mode' set to nil.
1332 ;;   Thanks to <stig A T hackvan com>
1333 ;;
1334 ;; Jun 19 1996  19.31             [andersl]
1335 ;; - The code has proven itself stable through the beta testing phase
1336 ;;   which has lasted the past six months.
1337 ;; - A lot of comments written.
1338 ;; - The package `folding-isearch' integrated.
1339 ;; - Some code cleanup:
1340 ;;   BOLP -> folding-BOL                   :! renamed
1341 ;;   folding-behave-table                  :! field `down' removed.
1342 ;;
1343 ;;
1344 ;; Mar 14 1996  19.28             [jari  1.27]
1345 ;; - No code changes. Only some textual corrections/additions.
1346 ;; - Section "about keymaps" added.
1347 ;;
1348 ;; Mar 14 1996  19.28             [jackr 1.26]
1349 ;; - spell-check run over code.
1350 ;;
1351 ;; Mar 14 1996  19.28             [davidm 1.25]
1352 ;; - David Masterson <davidm A T prism kla com> This patch makes the menubar in
1353 ;;   XEmacs work better. After I made this patch, the Hyperbole menus
1354 ;;   starting working as expected again. I believe the use of
1355 ;;   set-buffer-menubar has a problem, so the recommendation in XEmacs
1356 ;;   19.13 is to use set-menubar-dirty-flag.
1357 ;;
1358 ;; Mar 13 1996  19.28             [andersl 1.24]
1359 ;; - Corrected one minor bug in folding-check-if-folding-allowed
1360 ;;
1361 ;; Mar 12 1996  19.28             [jari 1.23]
1362 ;; - Renamed all -func variables to -function.
1363 ;;
1364 ;; mar 12 1996  19.28             [jari 1.22]
1365 ;; - Added new example how to change the fold marks. The automatic folding
1366 ;;   was reported to cause unnecessary delays for big files (eg. when using
1367 ;;   ediff) Now there is new function variable which can totally disable
1368 ;;   automatic folding if the return value is nil.
1369 ;;
1370 ;;   folding-check-allow-folding-function   :+ new variable
1371 ;;   folding-check-if-folding-allowed       :+ new func
1372 ;;   folding-mode-find-file                 :! modified
1373 ;;   folding-mode-write-file                :! better docs
1374 ;;   folding-goto-line                      :! arg "n" --> "N" due to XEmacs 19.13
1375 ;;
1376 ;; Mar 11 1996  19.28             [jari 1.21]
1377 ;; - Integrated changes made by Anders' to v1.19 [folding in beta dir]
1378 ;;
1379 ;; Jan 25 1996  19.28             [jari 1.20]
1380 ;; - ** Mainly cosmetic changes **
1381 ;; - Added some 'Section' codes that can be used with lisp-mnt.el
1382 ;; - Deleted all code in 'special section' because it was never used.
1383 ;; - Moved some old "-v-" named variables to better names.
1384 ;; - Removed folding-mode-flag that was never used.
1385 ;;
1386 ;; Jan 25 1996  19.28             [jari 1.19]
1387 ;; - Put Anders' latest version into RCS tree.
1388 ;;
1389 ;; Jan 03 1996  19.30             [andersl]
1390 ;; - `folding-mouse-call-original' uses `call-interactively'.
1391 ;;   `folding-mouse-context-sensitive' doesn't do `save-excursion'.
1392 ;;   (More changes will come later.)
1393 ;;   `folding-mouse-yank-at-p' macro corrected  (quote added).
1394 ;;   Error for `epoch::version' removed.
1395 ;;   `folding-mark-look-at' Regexp change .* -> [^\n\r]* to avoid error.
1396 ;;
1397 ;; Nov 24 1995  19.28             [andersl]
1398 ;; - (sequencep ) added to the code which checks for the existence
1399 ;;   of a tools menu.
1400 ;;
1401 ;; Aug 27 1995  19.28 19.12       [andersl]
1402 ;; - Keybindings restructured. They now conforms with the
1403 ;;   new 19.29 styleguide. Old keybindings are still available.
1404 ;; - Menus new goes into the "Tools" menu, if present.
1405 ;; - `folding-mouse-open-close' renamed to
1406 ;;   `folding-mouse-context-sensitive'.
1407 ;; - New entry `other' in `folding-behave-table' which defaults to
1408 ;;   `folding-calling-original'.
1409 ;; - `folding-calling-original' now gets the event from `last-input-event'
1410 ;;   if called without arguments (i.e. the way `folding-act' calls it.)
1411 ;; - XEmacs mouse support added.
1412 ;; - `folding-mouse-call-original' can call functions with or without
1413 ;;   the Event argument.
1414 ;; - Byte compiler generates no errors neither for Emacs 19 and XEmacs.
1415 ;;
1416 ;; Aug 24 1995  19.28             [jari  1.17]
1417 ;; - To prevent infinite back calling loop, Anders suggested smart way
1418 ;;   to detect that func call chain is started only once.
1419 ;;   folding-calling-original      :+ v, call chain terminator
1420 ;;   "Internal"                 :! v, all private vars have this string
1421 ;;   folding-mouse-call-original   :! v, stricter chain check.
1422 ;;   "copyright"                :! t, newer notice
1423 ;;   "commentary"               :! t, ripped non-supported emacsen
1424 ;;
1425 ;; Aug 24 1995  19.28             [jari  1.16]
1426 ;; ** mouse interface rewritten
1427 ;; - Anders gave many valuable comments about simplifying the mouse usage,
1428 ;;   he suggested that every mouse function should accept standard event,
1429 ;;   and it should be called directly.
1430 ;;   folding-global                 :- v, not needed
1431 ;;   folding-mode-off-hook          :- v, not needed
1432 ;;   folding-mouse-action-table     :- v, not needed any more
1433 ;;   folding-default-keys-function  :+ v, key settings
1434 ;;   folding-default-mouse-keys-function:+ v, key settings
1435 ;;   folding-mouse                  :- f, unnecessary
1436 ;;   'all mouse funcs'              :! f, now accept "e" parameter
1437 ;;   folding-default-keys           :+ f, defines keys
1438 ;;   folding-mouse-call-original    :+ f, call orig mouse func
1439 ;;   "examples"                     :! t, radical rewrote, only one left
1440 ;;
1441 ;; Aug 24 1995  19.28             [jari  1.15]
1442 ;; - some minor changes. If we're inside a fold, Mouse-3 will go one
1443 ;;   level up if it points END or BEG marker.
1444 ;;   folding-mouse-yank-at-point:! v, added 'up 'down
1445 ;;   folding-mark-look-at       :! f, more return values: '11 and 'end-in
1446 ;;   folding-open-close         :! f, bug, didn't exit if inside fold
1447 ;;   PMIN, PMAX, NEXTP, add-l   :+ more macros fom tinylibm.el
1448 ;;
1449 ;; Aug 23 1995  19.28             [andersl 1.14]
1450 ;; - Added `eval-when-compile' around 1.13 byte-compiler fix
1451 ;;   to avoid code to be executed when using a byte-compiled version
1452 ;;   of folding.el.
1453 ;; - Binds mode keys via `minor-mode-map-alist'
1454 ;;   (i.e. `folding-merge-keymaps' is not used in modern Emacsen.)
1455 ;;   This means that the user can not bind `folding-mode-map' to a new
1456 ;;   keymap, \\(s\\|\\)he must modify the existing one.
1457 ;; - `defvars' for global feature test variables `folding-*-p'.
1458 ;; - `folding-mouse-open-close' now detects when the current fold was been
1459 ;;   pressed. (The "current" is the fold around which the buffer is
1460 ;;   narrowed.)
1461 ;;
1462 ;; Aug 23 1995  19.28             [jari  1.13]
1463 ;; - 19.28 Byte compile doesn't handle fboundp, boundp well. That's a bug.
1464 ;;   Set some dummy functions to get cleaner output.
1465 ;; - The folding-mode-off doesn't seem very useful, because it
1466 ;;   is never run when another major-mode is turned on ... maybe we should
1467 ;;   utilize kill-all-local-variables-hooks with defadvice around
1468 ;;   kill-all-local-variables ...
1469 ;;
1470 ;;   folding-emacs-version  :+ added. it was in the docs, but not defined
1471 ;;   kill-all-local-variables-hooks  :! v, moved to variable section
1472 ;;   list-buffers-mode-alist         :! v, --''--
1473 ;;   "compiler hacks"                :+ section added
1474 ;;   "special"                       :+ section added
1475 ;;   "Compatibility"                 :! moved at the beginning
1476 ;;
1477 ;; Aug 22 1995  19.28             [jari  1.12]
1478 ;; - Only minor changes
1479 ;;   BOLP, BOLPP, EOLP, EOLPP   :+ f, macros added from tinylibm.el
1480 ;;   folding-mouse-pick-move    :! f, when cursor at beolp, move always up
1481 ;;   "bindings"                 :+ added C-cv and C-cC-v
1482 ;;
1483 ;; Aug 22 1995  19.28             [jari  1.11]
1484 ;; - Inspired by mouse so much, that this revision contain substantial
1485 ;;   changes and enhancements. Mouse is now powered!
1486 ;; - Anders wanted mouse to operate according to 'mouse cursor', not
1487 ;;   current 'point'.
1488 ;;   folding-mouse-yank-at-point: controls it. Phwew, I like this
1489 ;;   one a lot.
1490 ;;
1491 ;;   examples                       :! t, totally changed, now 2 choices
1492 ;;   folding-mode-off-hook          :+ v, when folding ends
1493 ;;   folding-global                 :+ v, global store value
1494 ;;   folding-mouse-action-table     :! v, changed
1495 ;;   folding-mouse                  :! f, stores event to global
1496 ;;   folding-mouse-open-close       :! f, renamed, mouse activated open
1497 ;;   folding-mode                   :! f, added 'off' hook
1498 ;;   folding-event-posn             :+ f, handles FSF mouse event
1499 ;;   folding-mouse-yank-at-p        :+ f, check which mouse mode is on
1500 ;;   folding-mouse-point            :+ f, return working point
1501 ;;   folding-mouse-move             :+ f, mouse moving down  , obsolete ??
1502 ;;   folding-mouse-pick-move            :+ f, mouse move accord. fold mark
1503 ;;   folding-next-visible-heading       :+ f, from tinyfold.el
1504 ;;   folding-previous-visible-heading   :+ f, from tinyfold.el
1505 ;;   folding-pick-move                  :+ f, from tinyfold.el
1506 ;;
1507 ;;
1508 ;; Aug 22 1995  19.28             [jari  1.10]
1509 ;; - Minor typing errors corrected : fol-open-close 'hide --> 'close
1510 ;;   This caused error when trying to close open fold with mouse
1511 ;;   when cursor was sitting on fold marker.
1512 ;;
1513 ;; Aug 22 1995  19.28             [jari  1.9]
1514 ;; - Having heard good suggestions from Anders...!
1515 ;;   "install"                  : add-hook for folding missed
1516 ;;   folding-open-close            : generalized
1517 ;;   folding-behave-table          : NEW, logical behavior control
1518 ;;   folding-:mouse-action-table   : now folding-mouse-action-table
1519 ;;
1520 ;; - The mouse function seems to work with FSF emacs only, because
1521 ;;   XEmacs doesn't know about double or triple clicks. We're working
1522 ;;   on the problem...
1523 ;;
1524 ;; Aug 21 1995  19.28             [jari  1.8]
1525 ;; - Rearranged the file structure so that all variables are at the
1526 ;;   beginning of file. With new functions, it easy to open-close
1527 ;;   fold. Added word "code:" or "setup:" to the front of code folds,
1528 ;;   so that the toplevel folds can be recognized more easily.
1529 ;; - Added example hook to install section for easy mouse use.
1530 ;; - Added new functions.
1531 ;;   folding-get-mode-marks : return folding marks
1532 ;;   folding-mark-look-at   : status of current line, fold mark in it?
1533 ;;   folding-mark-mouse     : execute action on fold mark
1534 ;;
1535 ;;
1536 ;; Aug 17 1995  19.28/X19.12      [andersl 1.7]
1537 ;; - Failed when loaded into XEmacs, when `folding-mode-map' was
1538 ;;   undefined.  Folding marks for three new major modes added:
1539 ;;   rexx-mode, erlang-mode and xerl-mode.
1540 ;;
1541 ;; Aug 14 1995  19.28             [jari  1.6]
1542 ;; - After I met Anders we exchanged some thoughts about usage philosophy
1543 ;;   of error and signal commands. I was annoyed by the fact that they
1544 ;;   couldn't be suppressed, when the error was "minor". Later Anders
1545 ;;   developed fdb.el, which will be integrated to FSF 19.30. It
1546 ;;   offers by-passing error/signal interference.
1547 ;;   --> I changed back all the error commands that were taken away.
1548 ;;
1549 ;; Jun 02 1995  19.28             [andersl]
1550 ;; - "Narrow" not present in mode-line when in folding-mode.
1551 ;;
1552 ;; May 12 1995  19.28             [jari  1.5]
1553 ;; - Installation text cleaned: reference to 'install-it' removed,
1554 ;;   because such function doesn't exist any more. The installation is
1555 ;;   now automatic: it's done when user calls folding mode first time.
1556 ;; - Added 'private vars' section. made 'outside all folds' message
1557 ;;   informational, not an error.
1558 ;;
1559 ;; May 12 1995  19.28             [jackr  x.x]
1560 ;; - Corrected 'broken menu bar' problem.
1561 ;; - Even though make-sparse-keymap claims its argument (a string to
1562 ;;   name the  menu) is optional, it's not. Lucid has other
1563 ;;   arrangements for the same thing..
1564 ;;
1565 ;; May 10 1995  19.28             [jari 1.2]
1566 ;; - Moved provide to the end of file.
1567 ;; - Rearranged code so that the common functions are at the beginning.
1568 ;;   Reprogrammed the whole installation with hooks. Added Write file
1569 ;;   hook that makes sure you don't write in 'binary' while folding were
1570 ;;   accidentally off.
1571 ;; - Added regexp text for certain files which are not allowed to
1572 ;;   'auto fold' when loaded.
1573 ;; - changed some 'error' commands to 'messages', this prevent screen
1574 ;;   mixup when debug-on-error is set to t
1575 ;; + folding-list-delete , folding-msg , folding-mode-find-file ,
1576 ;;   folding-mode-write-file , folding-check-folded , folding-keep-hooked
1577 ;;
1578 ;; 1.7.4 May 04 1995  19.28             [jackr 1.11]
1579 ;; - Some compatibility changes:
1580 ;;      v.18 doesn't allow an arg to make-sparse-keymap
1581 ;;      testing epoch::version is trickier than that
1582 ;;      free-variable reference cleanup
1583 ;;
1584 ;; 1.7.3 May 04 1995  19.28             [jari]
1585 ;; - Corrected folding-mode-find-file-hook , so that it has more
1586 ;;   'mode turn on' capabilities through user function
1587 ;; + folding-mode-write-file-hook: Makes sure your file is saved
1588 ;;   properly, so that you don't end up saving in 'binary'.
1589 ;; + folding-check-folded: func, default checker provided
1590 ;; + folding-check-folded-file-function variable added, User can put his
1591 ;;   'detect folding.el file' methods here.
1592 ;; + folding-mode-install-it: func, Automatic installation with it
1593 ;;
1594 ;; 1.7.2  Apr 01 1995   19.28           [jackr] , Design support by [jari]
1595 ;; - Added folding to FSF & XEmacs menus
1596 ;;
1597 ;; 1.7.1  Apr 28 1995   19.28           [jackr]
1598 ;; - The folding editor's merge-keymap couldn't handle FSF menu-bar,
1599 ;;   so some minor changes were made, previous is '>' and enhancements
1600 ;;   are '>'
1601 ;;
1602 ;; <     (buffer-disable-undo new-buffer)
1603 ;; ---
1604 ;; >     (buffer-flush-undo new-buffer)
1605 ;; 1510,1512c1510
1606 ;; <                    key (if (symbolp keycode)
1607 ;; <                            (vector keycode)
1608 ;; <                          (char-to-string keycode))
1609 ;; ---
1610 ;; >                    key (char-to-string keycode)
1611 ;; 1802,1808d1799
1612 ;; < ;;{{{ Compatibility hacks for various Emacs versions
1613 ;; <
1614 ;; < (or (fboundp 'buffer-disable-undo)
1615 ;; <     (fset 'buffer-disable-undo (symbol-function 'buffer-flush-undo)))
1616 ;; <
1617 ;; < ;;}}}
1618 ;;
1619 ;;
1620 ;; X.x  Dec 1   1994    19.28           [jari]
1621 ;; - Only minor change. Made the folding mode string user configurable.
1622 ;;   Added these variables:
1623 ;;   folding-mode-string, folding-inside-string,folding-inside-mode-name
1624 ;; - Changed revision number from 1.6.2 to 1.7 , so that people know
1625 ;;   this package has changed.
1626
1627 ;;}}}
1628
1629 ;;; Code:
1630
1631 ;;{{{ setup: require packages
1632
1633 ;;; ......................................................... &require ...
1634
1635 (eval-when-compile (require 'cl))
1636 (require 'easymenu)
1637
1638 (defvar folding-package-url-location
1639   "Latest folding is available at http://cvs.xemacs.org/viewcvs.cgi/XEmacs/packages/xemacs-packages/text-modes/")
1640
1641 ;;}}}
1642 ;;{{{ setup: byte compiler hacks
1643
1644 ;;; ............................................. &byte-compiler-hacks ...
1645 ;;; - This really only should be evaluated in case we're about to byte
1646 ;;;   compile this file. Since `eval-when-compile' is evaluated when
1647 ;;;   the uncompiled version is used (great!) we test if the
1648 ;;;   byte-compiler is loaded.
1649
1650 ;; Make sure `advice' is loaded when compiling the code.
1651
1652 (eval-and-compile
1653   (require 'advice)
1654   (defvar folding-xemacs-p (or (boundp 'xemacs-logo)
1655                                (featurep 'xemacs))
1656     "Folding determines which emacs version it is running. t if Xemacs.")
1657   ;;  loading overlay.el package removes some byte compiler whinings.
1658   ;;  By default folding does not use overlay code.
1659   (if folding-xemacs-p
1660       (or (fboundp 'overlay-start)  ;; Already loaded
1661           (load "overlay" 'noerr)   ;; No? Try loading it.
1662           (message "\
1663 ** folding.el: XEmacs 19.15+ has package overlay.el, try to get it.
1664                This is only warning. Folding does not use overlays by
1665                default.  You can safely ignore possible overlay byte
1666                compilation error
1667                messages."))))
1668
1669 (eval-when-compile
1670
1671   (when nil ;; Disabled 2000-01-05
1672     ;; While byte compiling
1673     (if (string= (buffer-name) " *Compiler Input*")
1674         (progn
1675           (message "** folding.el:\
1676  Info, Ignore [X]Emacs's missing motion/event/posn functions calls"))))
1677
1678   ;; ARGS: (symbol variable-p library)
1679   (defadvice find-function-search-for-symbol (around folding act)
1680     "Set folding flag for `find-file-noselect' to open all folds."
1681     (let ((file (ad-get-arg 2)))
1682       (when file
1683         (message "FILE %s" file)
1684         (put 'find-file-noselect 'folding file)))
1685     ad-do-it
1686     (put 'find-file-noselect 'folding nil))
1687
1688   (defun folding-find-file-noselect ()
1689     (let* ((file   (get 'find-file-noselect 'folding))
1690            (buffer (and file
1691                         ;; It may be absolute path name, file.el,
1692                         ;; or just "file".
1693                         (or (find-buffer-visiting file)
1694                             (get-buffer file)
1695                             (get-buffer (concat file ".el"))))))
1696       (when buffer
1697         (with-current-buffer buffer
1698           (when (symbol-value 'folding-mode) ;; Byte compiler silencer
1699             (turn-off-folding-mode))))))
1700
1701   ;;  See find.func.el  find-function-search-for-symbol
1702   ;;  Make C-h f  and mouse-click work to jump to a file. Folding mode
1703   ;;  Must be turned off due to regexps in find.func.el that can't
1704   ;;  search ^M lines.
1705
1706   (defadvice find-file-noselect (after folding act)
1707     "When called by `find-function-search-for-symbol', turn folding off."
1708     (folding-find-file-noselect))
1709
1710   (defadvice make-sparse-keymap
1711     (before
1712      make-sparse-keymap-with-optional-argument
1713      (&optional byte-compiler-happyfier)
1714      activate)
1715     "This advice does nothing except adding an optional argument
1716 to keep the byte compiler happy when compiling Emacs specific code
1717 with XEmacs.")
1718
1719   ;; XEmacs and Emacs 19 differs when it comes to obsolete functions.
1720   ;; We're using the Emacs 19 versions, and this simply makes the
1721   ;; byte-compiler stop wining. (Why isn't there a warning flag which
1722   ;; could have turned off?)
1723
1724   (and (boundp 'mode-line-format)
1725        (put 'mode-line-format 'byte-obsolete-variable nil))
1726
1727   (and (fboundp 'byte-code-function-p)
1728        (put 'byte-code-function-p 'byte-compile nil))
1729
1730   (and (fboundp 'eval-current-buffer)
1731        (put 'eval-current-buffer 'byte-compile nil)))
1732
1733 (defsubst folding-preserve-active-region ()
1734   "In XEmacs keep the region alive. In Emacs do nothing."
1735   (if (boundp 'zmacs-region-stays)      ;Keep regions alive
1736       (set 'zmacs-region-stays t))) ;use `set' to Quiet Emacs Byte Compiler
1737
1738 ;; Work around the NT Emacs Cut'n paste bug in selective-display which
1739 ;; doesn't preserve C-m's. Only installed in problematic Emacs and
1740 ;; in other cases these lines are no-op.
1741
1742 (eval-and-compile
1743   (when (and (not folding-xemacs-p)
1744              (memq (symbol-value 'window-system) '(win32 w32)) ; NT Emacs
1745              (string< emacs-version "20.4")) ;at least in 19.34 .. 20.3.1
1746
1747     (unless (fboundp 'char-equal)
1748       (defalias 'char-equal  'equal))
1749
1750     (unless (fboundp 'subst-char)
1751       (defun subst-char (str char to-char)
1752         "Replace in STR every CHAR with TO-CHAR."
1753         (let ((len   (length str))
1754               (ret   (copy-sequence str))) ;because 'aset' is destructive
1755           (while (> len 0)
1756             (if (char-equal (aref str (1- len)) char)
1757                 (aset ret (1- len) to-char))
1758             (decf len))
1759           ret)))
1760
1761     (defadvice kill-new (around folding-win32-fix-selective-display act)
1762       "In selective display, convert each C-m to C-a. See `current-kill'."
1763       (let* ((string (ad-get-arg 0)))
1764         (when (and selective-display (string-match "\C-m" (or string "")))
1765           (setq string (subst-char string ?\C-m ?\C-a)))
1766         ad-do-it))
1767
1768     (defadvice current-kill (around folding-win32-fix-selective-display act)
1769       "In selective display, convert each C-a back to C-m. See `kill-new'."
1770       ad-do-it
1771       (let* ((string ad-return-value))
1772         (when (and selective-display (string-match "\C-a" (or string "")))
1773           (setq string (subst-char string ?\C-a ?\C-m))
1774           (setq ad-return-value string))))))
1775
1776 (defvar folding-mode) ;; Byte Compiler silencer
1777
1778 (when (locate-library "mode-motion") ;; XEmacs
1779   (defun folding-mode-motion-highlight-fold (event)
1780     "Highlight line under mouse if it has a foldmark."
1781     (when folding-mode
1782       (funcall
1783        ;; Emacs Byte Compiler Shutup fix
1784        (symbol-function 'mode-motion-highlight-internal)
1785        event
1786        (function
1787         (lambda ()
1788           (beginning-of-line)
1789           (if (folding-mark-look-at)
1790               (search-forward-regexp "^[ \t]*"))))
1791        (function
1792         (lambda ()
1793           (if (folding-mark-look-at)
1794               (end-of-line)))))))
1795   (require 'mode-motion)
1796   (add-hook 'mode-motion-hook 'folding-mode-motion-highlight-fold 'at-end))
1797
1798 ;;}}}
1799
1800 ;;{{{ setup: some variable
1801
1802 ;;; .................................................. &some-variables ...
1803
1804 ;; This is a list of structures which keep track of folds being entered
1805 ;; and exited. It is a list of (MARKER . MARKER) pairs, followed by the
1806 ;; symbol `folded'. The first of these represents the fold containing
1807 ;; the current one. If the view is currently outside all folds, this
1808 ;; variable has value nil.
1809
1810 (defvar folding-stack nil
1811   "Internal. A list of marker pairs representing folds entered so far.")
1812
1813 (defvar folding-version (substring "$Revision: 1.25 $" 11 15)
1814   "Version number of folding.el.")
1815
1816 ;;}}}
1817 ;;{{{ setup: bind
1818
1819 ;;; .......................................................... &v-bind ...
1820
1821 (defgroup folding nil
1822   "Managing buffers with Folds."
1823   :group 'tools)
1824
1825 (defcustom folding-mode-prefix-key "\C-c@"
1826   "*Prefix key to use for Folding commands in Folding mode."
1827   :type  'string
1828   :group 'folding)
1829
1830 (defcustom folding-goto-key "\M-g"
1831   "*Key to be bound to `folding-goto-line' in folding mode.
1832 The default value is M - g, but you probably don't want folding to
1833 occupy it if you have used M - g got `goto-line'."
1834   :type  'string
1835   :group 'folding)
1836
1837 (defcustom folding-font-lock-begin-mark 'font-lock-reference-face
1838   "Face to highlight beginning fold mark."
1839   :type  'face
1840   :group 'folding)
1841
1842 (defcustom folding-font-lock-end-mark 'font-lock-reference-face
1843   "Face to highlight end fold mark."
1844   :type  'face
1845   :group 'folding)
1846
1847 (defvar folding-mode-map nil
1848   "Keymap used in Folding mode (a minor mode).")
1849
1850 (defvar folding-mode-prefix-map nil
1851   "Keymap used in Folding mode keys sans `folding-mode-prefix-key'.")
1852
1853 ;;;###autoload
1854 (defvar folding-mode nil
1855   "When Non nil, Folding mode is active in the current buffer.")
1856
1857 (make-variable-buffer-local 'folding-mode)
1858 (set-default 'folding-mode nil)
1859
1860 (defmacro folding-kbd (key function)
1861   "Folding: define KEY with FUNCTION to `folding-mode-prefix-map'.
1862 This is used when assigning keybindings to `folding-mode-map'.
1863 See also `folding-mode-prefix-key'."
1864   `(define-key
1865      folding-mode-prefix-map
1866      ,key ,function))
1867
1868 (defun folding-bind-default-mouse ()
1869   "Bind default mouse keys used by Folding mode."
1870   (interactive)
1871   (cond
1872    (folding-xemacs-p
1873     (define-key folding-mode-map [(button3)]
1874       'folding-mouse-context-sensitive)
1875     ;; (define-key folding-mode-map '(double button3) 'folding-hide-current-entry)
1876     (define-key folding-mode-map [(control shift button2)]
1877       'folding-mouse-pick-move))
1878    (t
1879     (define-key folding-mode-map [mouse-3]     'folding-mouse-context-sensitive)
1880     (define-key folding-mode-map [C-S-mouse-2] 'folding-mouse-pick-move))))
1881
1882 (defun folding-bind-terminal-keys ()
1883   "In non-window system, rebind C - f and C - b as folding-{forward,backward}-char."
1884   (unless (or (and (boundp 'window-system)        ;; Emacs
1885                    (symbol-value 'window-system)) ;; Byte compiler silencer
1886               (and (fboundp 'console-type)        ;; XEmacs
1887                    (let ((val (fboundp 'console-type)))
1888                      (not (eq 'tty val)))))
1889     (define-key folding-mode-map "\C-f" 'folding-forward-char)
1890     (define-key folding-mode-map "\C-b" 'folding-backward-char)))
1891
1892 (defun folding-bind-default-keys ()
1893   "Bind the default keys used the `folding-mode'.
1894
1895 The variable `folding-mode-prefix-key' contains the prefix keys,
1896 the default is C - c @.
1897
1898 For the good ol' key bindings, please use the function
1899 `folding-bind-backward-compatible-keys' instead."
1900   (interactive)
1901   (define-key folding-mode-map folding-goto-key 'folding-goto-line)
1902   (folding-bind-terminal-keys)
1903   (define-key folding-mode-map "\C-e" 'folding-end-of-line)
1904   (folding-kbd "\C-f"   'folding-fold-region)
1905   (folding-kbd ">"      'folding-shift-in)
1906   (folding-kbd "<"      'folding-shift-out)
1907   (folding-kbd "\C-t"   'folding-show-all)
1908   (folding-kbd "\C-s"   'folding-show-current-entry)
1909   (folding-kbd "\C-x"   'folding-hide-current-entry)
1910   (folding-kbd "\C-o"   'folding-open-buffer)
1911   (folding-kbd "\C-w"   'folding-whole-buffer)
1912   (folding-kbd "\C-r"   'folding-convert-buffer-for-printing)
1913   (folding-kbd "\C-k"   'folding-marks-kill)
1914   (folding-kbd  "\C-v"  'folding-pick-move)
1915   (folding-kbd  "v"     'folding-previous-visible-heading)
1916   (folding-kbd  " "     'folding-next-visible-heading)
1917   (folding-kbd  "."     'folding-context-next-action)
1918   ;;  C-u:  kinda "up" -- "down"
1919   (folding-kbd "\C-u"   'folding-toggle-enter-exit)
1920   (folding-kbd "\C-q"   'folding-toggle-show-hide)
1921   ;; Think "#" as a 'fence'
1922   (folding-kbd "#"      'folding-region-open-close)
1923   ;; Esc-; is the standard emacs commend add key.
1924   (folding-kbd ";"      'folding-comment-fold)
1925   (folding-kbd "%"      'folding-convert-to-major-folds)
1926   (folding-kbd "/"      'folding-all-comment-blocks-in-region)
1927   (folding-kbd "\C-y"   'folding-show-current-subtree)
1928   (folding-kbd "\C-z"   'folding-hide-current-subtree)
1929   (folding-kbd "\C-n"   'folding-display-name)
1930
1931   (folding-kbd "I"      'folding-insert-advertise-folding-mode))
1932
1933 (defun folding-bind-backward-compatible-keys ()
1934   "Bind keys traditionally used by Folding mode.
1935 For bindings which follow newer Emacs minor mode conventions, please
1936 use the function `folding-bind-default-keys'.
1937
1938 This function sets `folding-mode-prefix-key' to `C-c'."
1939   (interactive)
1940   (setq folding-mode-prefix-key "\C-c")
1941   (folding-bind-default-keys))
1942
1943 (defun folding-bind-outline-compatible-keys ()
1944   "Bind keys used by the minor mode `folding-mode'.
1945 The keys used are as much as possible compatible with
1946 bindings used by Outline mode.
1947
1948 Currently, some outline mode functions doesn't have a corresponding
1949 folding function.
1950
1951 The variable `folding-mode-prefix-key' contains the prefix keys,
1952 the default is C - c @.
1953
1954 For the good ol' key bindings, please use the function
1955 `folding-bind-backward-compatible-keys' instead."
1956   (interactive)
1957   ;; Traditional keys:
1958   (folding-bind-terminal-keys)
1959   (define-key folding-mode-map "\C-e" 'folding-end-of-line)
1960   ;; Mimic Emacs 20.3 allout.el bindings
1961   (folding-kbd ">"          'folding-shift-in)
1962   (folding-kbd "<"          'folding-shift-out)
1963   (folding-kbd "\C-n"  'folding-next-visible-heading)
1964   (folding-kbd "\C-p"  'folding-previous-visible-heading)
1965   ;; ("\C-u" outline-up-current-level)
1966   ;; ("\C-f" outline-forward-current-level)
1967   ;; ("\C-b" outline-backward-current-level)
1968   ;;  (folding-kbd "\C-i"  'folding-show-current-subtree)
1969   (folding-kbd "\C-s"  'folding-show-current-subtree)
1970   (folding-kbd "\C-h"  'folding-hide-current-subtree)
1971   (folding-kbd "\C-k"  'folding-marks-kill)
1972   (folding-kbd "!"     'folding-show-all)
1973   (folding-kbd "\C-d"  'folding-hide-current-entry)
1974   (folding-kbd "\C-o"  'folding-show-current-entry)
1975   ;; (" " outline-open-sibtopic)
1976   ;; ("." outline-open-subtopic)
1977   ;; ("," outline-open-supertopic)
1978   ;; Other bindings not in allout.el
1979   (folding-kbd "\C-a"  'folding-open-buffer)
1980   (folding-kbd "\C-q"  'folding-whole-buffer)
1981   (folding-kbd "\C-r"  'folding-convert-buffer-for-printing)
1982   (folding-kbd "\C-w"  'folding-fold-region)
1983   (folding-kbd "I"      'folding-insert-advertise-folding-mode))
1984
1985 ;;{{{ goto-line (advice)
1986
1987 (defcustom folding-advice-instantiate t
1988   "*In non-nil install advice code. Eg for `goto-line'."
1989   :type  'boolean
1990   :group 'folding)
1991
1992 (defcustom folding-shift-in-on-goto t
1993   "*Flag in folding adviced function `goto-line'.
1994 If non-nil, folds are entered when going to a given line.
1995 Otherwise the buffer is unfolded. Can also be set to 'show.
1996 This variable is used only if `folding-advice-instantiate' was
1997 non-nil when folding was loaded.
1998
1999 See also `folding-goto-key'."
2000   :type  'boolean
2001   :group 'folding)
2002
2003 (defvar folding-narrow-by-default t
2004   "If t (default) things like isearch will enter folds.  If nil the
2005 folds will be opened, but not entered.")
2006
2007 (when folding-advice-instantiate
2008   (eval-when-compile (require 'advice))
2009   ;; By Robert Marshall <rxmarsha A T bechtel com>
2010   (defadvice goto-line (around folding-goto-line first activate)
2011     "Go to line ARG, entering folds if `folding-shift-in-on-goto' is t.
2012 It attempts to keep the buffer in the same visibility state as before."
2013     (let () ;; (oldposn (point))
2014       ad-do-it
2015       (if (and folding-mode
2016                (or (folding-point-folded-p (point))
2017                    (<= (point) (point-min-marker))
2018                    (>= (point) (point-max-marker))))
2019           (let ((line (ad-get-arg 0)))
2020             (if folding-shift-in-on-goto
2021                 (progn
2022                   (folding-show-all)
2023                   (goto-char 1)
2024                   (and (< 1 line)
2025                        (not (folding-use-overlays-p))
2026                        (re-search-forward "[\n\C-m]" nil 0 (1- line)))
2027                   (let ((goal (point)))
2028                     (while (prog2 (beginning-of-line)
2029                                (if (eq folding-shift-in-on-goto 'show)
2030                                    (progn
2031                                      (folding-show-current-entry t t)
2032                                      (folding-point-folded-p goal))
2033                                  (folding-shift-in t))
2034                              (goto-char goal)))
2035                     (folding-narrow-to-region
2036                      (and folding-narrow-by-default (point-min))
2037                      (point-max) t)))
2038               (if (or folding-stack (folding-point-folded-p (point)))
2039                   (folding-open-buffer))))))))
2040
2041 ;;}}}
2042
2043 (defun folding-bind-foldout-compatible-keys ()
2044   "Bind keys for `folding-mode' compatible with Foldout mode.
2045
2046 The variable `folding-mode-prefix-key' contains the prefix keys,
2047 the default is C - c @."
2048   (interactive)
2049   (folding-kbd "\C-z" 'folding-shift-in)
2050   (folding-kbd "\C-x" 'folding-shift-out))
2051
2052 ;;; This function is here, just in case we ever would like to add
2053 ;;; `hideif' support to folding mode. Currently, it is only used to
2054 ;;; which keys shouldn't be used.
2055
2056 ;;(defun folding-bind-hideif-compatible-keys ()
2057 ;;  "Bind keys for `folding-mode' compatible with Hideif mode.
2058 ;;
2059 ;;The variable `folding-mode-prefix-key' contains the prefix keys,
2060 ;;the default is C-c@."
2061 ;;  (interactive)
2062 ;;    ;; Keys defined by `hideif'
2063 ;;    ;; (folding-kbd "d" 'hide-ifdef-define)
2064 ;;    ;; (folding-kbd "u" 'hide-ifdef-undef)
2065 ;;    ;; (folding-kbd "D" 'hide-ifdef-set-define-alist)
2066 ;;    ;; (folding-kbd "U" 'hide-ifdef-use-define-alist)
2067 ;;
2068 ;;    ;; (folding-kbd "h") 'hide-ifdefs)
2069 ;;    ;; (folding-kbd "s") 'show-ifdefs)
2070 ;;    ;; (folding-kbd "\C-d") 'hide-ifdef-block)
2071 ;;    ;; (folding-kbd "\C-s") 'show-ifdef-block)
2072 ;;
2073 ;;    ;; (folding-kbd "\C-q" 'hide-ifdef-toggle-read-only)
2074 ;;    )
2075
2076 ;;; .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .
2077
2078 ;; Not used for modern Emacsen.
2079 (defvar folding-saved-local-keymap nil
2080   "Keymap used to save non-folding keymap.
2081 (so it can be restored when folding mode is turned off.)")
2082
2083 ;;;###autoload
2084 (defcustom folding-default-keys-function 'folding-bind-default-keys
2085   "*Function or list of functions used to define keys for Folding mode.
2086 Possible values are:
2087   folding-bind-default-key
2088         The standard keymap.
2089
2090   `folding-bind-backward-compatible-keys'
2091         Keys used by older versions of Folding mode. This function
2092         does not conform to Emacs 19.29 style conversions concerning
2093         key bindings. The prefix key is C - c
2094
2095   `folding-bind-outline-compatible-keys'
2096         Define keys compatible with Outline mode.
2097
2098   `folding-bind-foldout-compatible-keys'
2099         Define some extra keys compatible with Foldout.
2100
2101 All except `folding-bind-backward-compatible-keys' used the value of
2102 the variable `folding-mode-prefix-key' as prefix the key.
2103 The default is C - c @"
2104   :type  'function
2105   :group 'folding)
2106
2107 ;; Not yet implemented:
2108 ;;  folding-bind-hideif-compatible-keys
2109 ;;      Define some extra keys compatible with hideif.
2110
2111 ;;;###autoload
2112 (defcustom folding-default-mouse-keys-function 'folding-bind-default-mouse
2113   "*Function to bind default mouse keys to `folding-mode-map'."
2114   :type 'function
2115   :group 'folding)
2116
2117 (defvar folding-mode-menu nil
2118   "Keymap containing the menu for Folding mode.")
2119
2120 (defvar folding-mode-menu-name "Fld" ;; Short menu name
2121   "Name of pull down menu.")
2122
2123 ;;}}}
2124 ;;{{{ setup: hooks
2125
2126 ;;; ......................................................... &v-hooks ...
2127
2128 (defcustom folding-mode-hook nil
2129   "*Hook called when Folding mode is entered.
2130
2131 A hook named `<major-mode>-folding-hook' is also called, if it
2132 exists. Eg., `c-mode-folding-hook' is called whenever Folding mode is
2133 started in C mode."
2134   :type 'hook
2135   :group 'folding)
2136
2137 (defcustom folding-load-hook nil
2138   "*Hook run when file is loaded."
2139   :type 'hook
2140   :group 'folding)
2141
2142 ;;}}}
2143 ;;{{{ setup: user config
2144
2145 ;;; ........................................................ &v-Config ...
2146
2147 ;; Q: should this inherit mouse-yank-at-point's value? maybe not.
2148 (defvar folding-mouse-yank-at-point t
2149   "If non-nil, mouse activities are done at point instead of 'mouse cursor'.
2150 Behaves like `mouse-yank-at-point'.")
2151
2152 (defcustom folding-folding-on-startup t
2153   "*If non-nil, buffers are folded when starting Folding mode."
2154   :type 'boolean
2155   :group 'folding)
2156
2157 (defcustom folding-internal-margins 1
2158   "*Number of blank lines left next to fold mark when tidying folds.
2159
2160 This variable is local to each buffer. To set the default value for all
2161 buffers, use `set-default'.
2162
2163 When exiting a fold, and at other times, `folding-tidy-inside' is invoked
2164 to ensure that the fold is in the correct form before leaving it. This
2165 variable specifies the number of blank lines to leave between the
2166 enclosing fold marks and the enclosed text.
2167
2168 If this value is nil or negative, no blank lines are added or removed
2169 inside the fold marks. A value of 0 (zero) is valid, meaning leave no
2170 blank lines.
2171
2172 See also `folding-tidy-inside'."
2173   :type  'boolean
2174   :group 'folding)
2175
2176 (make-variable-buffer-local 'folding-internal-margins)
2177
2178 (defvar folding-mode-string " Fld"
2179   "Buffer-local variable that hold the fold depth description.")
2180
2181 (set-default 'folding-mode-string " Fld")
2182
2183 ;; Sets `folding-mode-string' appropriately. This allows the Folding mode
2184 ;; description in the mode line to reflect the current fold depth.
2185
2186 (defconst folding-inside-string " "     ; was ' inside ',
2187   "Mode line addition to show 'inside' levels of fold.")
2188
2189 ;;;###autoload
2190 (defcustom folding-inside-mode-name "Fld"
2191   "*Mode line addition to show inside levels of 'fold' ."
2192   :type  'string
2193   :group 'folding)
2194
2195 (defcustom folding-check-folded-file-function
2196   'folding-check-folded
2197   "*Function that return t or nil after examining if the file is folded."
2198   :type  'function
2199   :group 'folding)
2200
2201 (defcustom folding-check-allow-folding-function
2202   'folding-check-if-folding-allowed
2203   "*Function that return t or nil after deciding if automatic folding."
2204   :type  'function
2205   :group 'folding)
2206
2207 ;;;###autoload
2208 (defcustom folding-mode-string "Fld"
2209   "*The minor mode string displayed when mode is on."
2210   :type  'string
2211   :group 'folding)
2212
2213 ;;;###autoload
2214 (defcustom folding-mode-hook-no-regexp "RMAIL"
2215   "*Regexp which disable automatic folding mode turn on for certain files."
2216   :type  'string
2217   :group 'folding)
2218
2219 ;;; ... ... ... ... ... ... ... ... ... ... ... ... ... .... &v-tables ...
2220
2221 (defcustom folding-behave-table
2222   '((close      folding-hide-current-entry)
2223     (open       folding-show-current-entry) ; Could also be `folding-shift-in'.
2224     (up         folding-shift-out)
2225     (other      folding-mouse-call-original))
2226   "*Table of of logical commands and their associated functions.
2227 If you want fold to behave like `folding-shift-in', when it 'open'
2228 a fold, you just change the function entry in this table.
2229
2230 Table form:
2231   '( (LOGICAL-ACTION  CMD) (..) ..)"
2232   :type '(repeat
2233           (symbol   :tag "logical action")
2234           (function :tag "callback"))
2235   :group 'folding)
2236
2237 ;;; ... ... ... ... ... ... ... ... ... ... ... ... ... ..... &v-marks ...
2238
2239 ;;;###autoload
2240 (defvar folding-mode-marks-alist nil
2241   "List of (major-mode . fold mark) default combinations to use.
2242 When Folding mode is started, the major mode is checked, and if there
2243 are fold marks for that major mode stored in `folding-mode-marks-alist',
2244 those marks are used by default. If none are found, the default values
2245 of \"{{{ \" and \"}}}\" are used.
2246
2247 Use function  `folding-add-to-marks-list' to add more fold marks. The function
2248 also explains the alist use in details.
2249
2250 Use function `folding-set-local-variables' if you change the current mode's
2251 folding marks during the session.")
2252
2253 ;;}}}
2254 ;;{{{ setup: private
2255
2256 ;;; ....................................................... &v-private ...
2257
2258 (defvar folding-narrow-placeholder nil
2259   "Internal. Mark where \"%n\" used to be in `mode-line-format'.
2260 Must be nil.")
2261
2262 (defvar folding-bottom-mark nil
2263   "Internal marker of the true bottom of a fold.")
2264
2265 (defvar folding-bottom-regexp nil
2266   "Internal. Regexp marking the bottom of a fold.")
2267
2268 (defvar folding-regexp nil
2269   "Internal. Regexp for hunting down the `folding-top-mark' even in comments.")
2270
2271 (defvar folding-secondary-top-mark nil
2272   "Internal. Additional stuff that can be inserted as part of a top marker.")
2273
2274 (defvar folding-top-mark nil
2275   "Internal. The actual string marking the top of a fold.")
2276
2277 (defvar folding-top-regexp nil
2278   "Internal.
2279 Regexp describing the string beginning a fold, possible with
2280 leading comment thingies and like that.")
2281
2282 (defvar folded-file nil
2283   "Enter folding mode when this file is loaded.
2284 (buffer local, use from a local variables list).")
2285
2286 (defvar folding-calling-original nil
2287   "Internal. Non-nil when original mouse binding is executed.")
2288
2289 (defvar folding-narrow-overlays nil
2290   "Internal. Keep the list of overlays.")
2291 (make-variable-buffer-local 'folding-narrow-overlays)
2292
2293 (defcustom folding-allow-overlays nil
2294   "*If non-nil use overlay code. If nil, then selective display is used.
2295 Note, that this code is highly experimental and will not most likely do what
2296 you expect. using value t will not change folding to use overlays
2297 completely. This variable was introduced to experiment with the overlay
2298 interface, but the work never finished and it is unlikely that it
2299 will continued any later time. Folding at present state is designed
2300 too highly for selective display to make the change worthwhile."
2301   :type 'boolean
2302   :group 'folding)
2303
2304 ;;}}}
2305 ;;{{{ Folding install
2306
2307 (defun folding-easy-menu-define ()
2308   "Define folding easy menu."
2309   (interactive)
2310   (easy-menu-define
2311     folding-mode-menu
2312     (if folding-xemacs-p
2313         nil
2314       (list folding-mode-map))
2315     "Folding menu"
2316     (list
2317      folding-mode-menu-name
2318      ["Enter Fold"                       folding-shift-in                t]
2319      ["Exit Fold"                        folding-shift-out               t]
2320      ["Show Fold"                        folding-show-current-entry      t]
2321      ["Hide Fold"                        folding-hide-current-entry      t]
2322      "----"
2323      ["Show Whole Buffer"                folding-open-buffer             t]
2324      ["Fold Whole Buffer"                folding-whole-buffer            t]
2325      ["Show subtree"                     folding-show-current-subtree    t]
2326      ["Hide subtree"                     folding-hide-current-subtree    t]
2327      ["Display fold name"                folding-display-name            t]
2328      "----"
2329      ["Move previous"                    folding-previous-visible-heading t]
2330      ["Move next"                        folding-next-visible-heading    t]
2331      ["Pick fold"                        folding-pick-move               t]
2332      ["Next action (context)"            folding-context-next-action     t]
2333      "----"
2334      ["Foldify region"                   folding-fold-region             t]
2335      ["Open or close folds in region"    folding-region-open-close       t]
2336      ["Open folds to top level"          folding-show-all                t]
2337      "----"
2338      ["Comment text in fold"             folding-comment-fold            t]
2339      ["Convert for printing(temp buffer)"
2340       folding-convert-buffer-for-printing t]
2341      ["Convert to major-mode folds"      folding-convert-to-major-folds  t]
2342      ["Move comments inside folds in region"
2343       folding-all-comment-blocks-in-region t]
2344      ["Delete fold marks in this fold"   folding-marks-kill              t]
2345      ["Insert folding URL reference"
2346       folding-insert-advertise-folding-mode t]
2347      "----"
2348      ["Toggle enter and exit mode"       folding-toggle-enter-exit       t]
2349      ["Toggle show and hide"             folding-toggle-show-hide        t]
2350      "----"
2351      ["Folding mode off"                 folding-mode t])))
2352
2353 (defun folding-install-keymaps ()
2354   "Install keymaps."
2355   (unless folding-mode-map
2356     (setq folding-mode-map          (make-sparse-keymap)))
2357   (unless folding-mode-prefix-map
2358     (setq folding-mode-prefix-map   (make-sparse-keymap)))
2359   (if (listp folding-default-keys-function)
2360       (mapcar 'funcall folding-default-keys-function)
2361     (funcall folding-default-keys-function))
2362   (funcall folding-default-mouse-keys-function)
2363   (folding-easy-menu-define)
2364   (define-key folding-mode-map
2365     folding-mode-prefix-key folding-mode-prefix-map)
2366   ;; Install the keymap into `minor-mode-map-alist'. The keymap will
2367   ;; be activated as soon as the variable `folding-mode' is set to
2368   ;; non-nil.
2369   (let ((elt (assq 'folding-mode minor-mode-map-alist)))
2370     ;;  Always remove old map before adding new definitions.
2371     (if elt
2372         (setq minor-mode-map-alist
2373               (delete elt minor-mode-map-alist)))
2374     (push (cons 'folding-mode folding-mode-map) minor-mode-map-alist))
2375   ;;  Update minor-mode-alist
2376   (or (assq 'folding-mode minor-mode-alist)
2377       (push '(folding-mode folding-mode-string) minor-mode-alist))
2378   ;;  Needed for XEmacs
2379   (or (fboundp 'buffer-disable-undo)
2380       (fset 'buffer-disable-undo (symbol-function 'buffer-flush-undo))))
2381
2382 (defun folding-uninstall-keymaps ()
2383   "Uninstall keymaps."
2384   (let ((elt (assq 'folding-mode minor-mode-map-alist)))
2385     (if elt
2386         (setq minor-mode-map-alist
2387               (delete elt minor-mode-map-alist)))
2388     (if (setq elt (assq 'folding-mode minor-mode-alist))
2389         (setq minor-mode-alist
2390               (delete elt minor-mode-alist)))
2391     (folding-uninstall-hooks)))
2392
2393 (defun folding-install (&optional uninstall)
2394   "Install or UNINSTALL folding."
2395   (interactive "P")
2396   (cond
2397    (uninstall
2398     (folding-uninstall-keymaps)
2399     (folding-uninstall-hooks))
2400    (t
2401     (folding-install-keymaps))))
2402
2403 (defun folding-uninstall ()
2404   "Uninstall folding."
2405   (interactive)
2406   (folding-install 'uninstall)
2407   ;; Unwrap all buffers.
2408   (dolist (buffer (buffer-list))
2409     (with-current-buffer buffer
2410       (goto-char (point-min))
2411       (when (or folding-mode
2412                 ;;  To be sure, check this at the same time
2413                 ;;  Somebody may have just done
2414                 ;;  (setq folding-mode nil), which is bad thing.
2415                 ;;  Setting variable won't restore the buffer.
2416                 (re-search-forward "{{{" nil t))
2417         (turn-off-folding-mode)))))
2418
2419 ;;}}}
2420 ;;{{{ code: misc
2421
2422 (defsubst folding-get-mode-marks (&optional mode)
2423   "Return fold markers for MODE. default is for current `major-mode'.
2424
2425 Return:
2426   \(beg-marker end-marker\)"
2427   (interactive)
2428   (let* (elt)
2429     (unless (setq elt (assq (or mode major-mode)
2430                             folding-mode-marks-alist))
2431       (error "Folding error: mode is not in `folding-mode-marks-alist'"))
2432     (list (nth 1 elt) (nth 2 elt) (nth 3 elt))))
2433
2434 (defun folding-region-has-folding-marks-p (beg end)
2435   "Check is there is fold mark in region BEG END."
2436   (save-excursion
2437     (goto-char beg)
2438     (when (memq (folding-mark-look-at) '(1 11))
2439       (goto-char end)
2440       (memq (folding-mark-look-at) '(end end-in)))))
2441
2442 ;;; - Thumb rule: because "{{{" if more meaningful, all returns values
2443 ;;;   are of type integerp if it is found.
2444 ;;;
2445 (defun folding-mark-look-at (&optional mode)
2446   "Check status of current line. Does it contain a fold mark?.
2447
2448 MODE
2449
2450  'move      move over fold mark
2451
2452 Return:
2453
2454   0 1       numberp, line has fold begin mark
2455             0 = closed, 1 = open,
2456             11 = open, we're inside fold, and this is top marker
2457
2458   'end      end mark
2459
2460   'end-in   end mark, inside fold, floor marker
2461
2462   nil       no fold marks .."
2463   (let* (case-fold-search
2464          (marks  (folding-get-mode-marks))
2465          (stack  folding-stack)
2466          (bm     (regexp-quote (nth 0 marks))) ;begin mark
2467          (em     (concat "^[ \t\n]*" (regexp-quote  (nth 1 marks))))
2468          (bm-re  (concat
2469                   (concat "^[ \t\n]*" bm)
2470                   (if (and nil
2471                            (string=
2472                             " " (substring (nth 0 marks)
2473                                            (length (nth 1 marks)))))
2474                       ;; Like "}}} *"
2475                       "*"
2476                     "")))
2477          ret
2478          point)
2479     (save-excursion
2480       (beginning-of-line)
2481       (cond
2482        ((looking-at bm-re)
2483         (setq point (point))
2484         (cond
2485          ((looking-at (concat "^[ \t\n]*" bm "[^\r\n]*\r")) ;; closed
2486           (setq ret 0))
2487          (t ;; open fold marker
2488           (goto-char (point-min))
2489           (cond
2490            ((and stack ;; we're inside fold
2491                  ;;  allow spaces
2492                  (looking-at (concat "[ \t\n]*" bm)))
2493             (setq ret 11))
2494            (t
2495             (setq ret 1))))))
2496        ((looking-at em)
2497         (setq point (point))
2498         ;; - The stack is a list if we've entered inside fold. There
2499         ;;   is no text after fold END mark
2500         ;; - At bol  ".*\n[^\n]*" doesn't work but "\n[^\n]*" at eol does??
2501         (cond
2502          ((progn
2503             (end-of-line)
2504             (or (and stack (eobp))      ;normal ending
2505                 (and stack             ;empty newlines only, no text ?
2506                      (not (looking-at "\n[^ \t\n]*")))))
2507           (setq ret 'end-in))
2508          (t                             ;all rest are newlines
2509           (setq ret 'end))))))
2510     (cond
2511      ((and mode point)
2512       (goto-char point)
2513       ;;  This call breaks if there is no marks on the point,
2514       ;;  because there is no parameter 'nil t' in call.
2515       ;;  --> there is error in this function if that happens.
2516       (beginning-of-line)
2517       (re-search-forward (concat bm "\\|" em))
2518       (backward-char 1)))
2519     ret))
2520
2521 (defsubst folding-mark-look-at-top-mark-p ()
2522   "Check if line contain folding top marker."
2523   (integerp (folding-mark-look-at)))
2524
2525 (defsubst folding-mark-look-at-bottom-mark-p ()
2526   "Check if line contain folding bottom marker."
2527   (symbolp (folding-mark-look-at)))
2528
2529 (defun folding-act (action &optional event)
2530   "Execute logical ACTION based on EVENT.
2531
2532 References:
2533   `folding-behave-table'"
2534   (let* ((elt (assoc action folding-behave-table)))
2535     (if elt
2536         (funcall (nth 1 elt) event)
2537       (error "Folding mode (folding-act): Unknown action %s" action))))
2538
2539 (defun folding-region-open-close (beg end &optional close)
2540   "Open all folds inside region BEG END. Close if optional CLOSE is non-nil."
2541   (interactive "r\nP")
2542   (let* ((func (if (null close)
2543                    'folding-show-current-entry
2544                  'folding-hide-current-entry))
2545          tmp)
2546     (save-excursion
2547       ;;   make sure the beg is first.
2548       (if (> beg end)                   ;swap order
2549           (setq  tmp beg  beg end   end tmp))
2550       (goto-char beg)
2551       (while (and
2552               ;;   the folding-show-current-entry/hide will move point
2553               ;;   to beg-of-line So we must move to the end of
2554               ;;   line to continue search.
2555               (if (and close
2556                        (eq 0 (folding-mark-look-at))) ;already closed ?
2557                   t
2558                 (funcall func)
2559                 (end-of-line)
2560                 t)
2561               (folding-next-visible-heading)
2562               (< (point) end))))))
2563
2564 (defun fold-marks-kill ()
2565   "If over fold, open fold and kill beginning and end fold marker.
2566 Return t ot nil if marks were removed."
2567   (interactive)
2568   (if (not (folding-mark-look-at))
2569       (when (interactive-p)
2570         (message "Folding: Cursor not over fold. Can't remove fold marks.")
2571         nil)
2572     (destructuring-bind (beg end)
2573         (folding-show-current-entry)
2574       (let ((kill-whole-line t))
2575         ;;  must be done in this order, because point moves after kill.
2576         (goto-char end)
2577         (beginning-of-line)
2578         (kill-line)
2579         (goto-char beg)
2580         (beginning-of-line)
2581         (kill-line)
2582         ;; Return status
2583         t))))
2584
2585 (defun folding-hide-current-subtree ()
2586   "Call `folding-show-current-subtree' with argument 'hide."
2587   (interactive)
2588   (folding-show-current-subtree 'hide))
2589
2590 (defun folding-show-current-subtree (&optional hide)
2591   "Show or HIDE all folds inside current fold.
2592 Point must be over beginning fold mark."
2593   (interactive "P")
2594   (let* ((stat  (folding-mark-look-at 'move))
2595          (beg   (point))
2596          end)
2597     (cond
2598      ((memq stat '(0 1 11))             ;It's BEG fold
2599       (when (eq 0 stat)                 ;it was closed
2600         (folding-show-current-entry)
2601         (goto-char beg))        ;folding-pick-move needs point at fold
2602       (save-excursion
2603         (if (folding-pick-move)
2604             (setq end (point))))
2605       (if (and beg end)
2606           (folding-region-open-close beg end hide)))
2607      (t
2608       (if (interactive-p)
2609           (message "point is not at fold beginning."))))))
2610
2611 (defun folding-display-name ()
2612   "Show current active fold name."
2613   (interactive)
2614   (let* ((pos    (folding-find-folding-mark))
2615          name)
2616     (when pos
2617       (save-excursion
2618         (goto-char pos)
2619         (if (looking-at ".*[{]+")       ;Drop "{" mark away.
2620             (setq pos (match-end 0)))
2621         (setq name (buffer-substring
2622                     pos
2623                     (progn
2624                       (end-of-line)
2625                       (point))))))
2626     (if name
2627         (message (format "fold:%s" name)))))
2628
2629 ;;}}}
2630 ;;{{{ code: events
2631
2632 (defun folding-event-posn (act event)
2633   "According to ACT read mouse EVENT struct and return data from it.
2634 Event must be simple click, no dragging.
2635
2636 ACT
2637   'mouse-point  return the 'mouse cursor' point
2638   'window       return window pointer
2639   'col-row      return list (col row)"
2640   (cond
2641    ((not folding-xemacs-p)
2642     ;; short Description of FSF mouse event
2643     ;;
2644     ;; EVENT : (mouse-3 (#<window 34 on *scratch*> 128 (20 . 104) -23723628))
2645     ;; event-start : (#<window 34 on *scratch*> 128 (20 . 104) -23723628))
2646     ;;                                          ^^^MP
2647     ;; mp = mouse point
2648     (let* ((el (funcall (symbol-function 'event-start) event)))
2649       (cond
2650        ((eq act 'mouse-point)
2651         (nth 1 el))                     ;is there macro for this ?
2652        ((eq act 'window)
2653         (funcall (symbol-function 'posn-window) el))
2654        ((eq act 'col-row)
2655         (funcall (symbol-function 'posn-col-row) el))
2656        (t
2657         (error "Unknown request" act)))))
2658
2659    (folding-xemacs-p
2660     (cond
2661      ((eq act 'mouse-point)
2662       (funcall (symbol-function 'event-point) event))
2663      ((eq act 'window)
2664       (funcall (symbol-function 'event-window) event))
2665      ;; Must be tested! (However, it's not used...)
2666      ((eq act 'col-row)
2667       (list (funcall (symbol-function 'event-x) event)
2668             (funcall (symbol-function 'event-y) event)))
2669      (t
2670       (error "Unknown request" act))))
2671    (t
2672     (error "This version of Emacs can't handle events."))))
2673
2674 (defmacro folding-interactive-spec-p ()
2675   "Preserve region during `interactive'.
2676 In XEmacs user could also set `zmacs-region-stays'."
2677   (if folding-xemacs-p
2678       ;;  preserve selected region
2679       `'(interactive "_p")
2680     `'(interactive "p")))
2681
2682 (defmacro folding-mouse-yank-at-p ()
2683   "Check if user use \"yank at mouse point\" feature.
2684
2685 Please see the variable `folding-mouse-yank-at-point'."
2686   'folding-mouse-yank-at-point)
2687
2688 (defun folding-mouse-point (&optional event)
2689   "Return mouse's working point. Optional EVENT is mouse click.
2690 When used on XEmacs, return nil if no character was under the mouse."
2691   (if (or (folding-mouse-yank-at-p)
2692           (null event))
2693       (point)
2694     (folding-event-posn 'mouse-point event)))
2695
2696 ;;}}}
2697
2698 ;;{{{ code: hook
2699
2700 (defun folding-is-hooked ()
2701   "Check if folding hooks are installed."
2702   (and (memq 'folding-mode-write-file write-file-hooks)
2703        (memq 'folding-mode-find-file  find-file-hooks)))
2704
2705 ;;;###autoload
2706 (defun folding-uninstall-hooks ()
2707   "Remove hooks set by folding."
2708   (turn-off-folding-mode)
2709   (remove-hook 'finder-mode-hook 'folding-mode)
2710   (remove-hook 'write-file-hooks 'folding-mode-write-file)
2711   (remove-hook 'find-file-hooks  'folding-mode-find-file))
2712
2713 ;;;###autoload
2714 (defun folding-install-hooks ()
2715   "Install folding hooks."
2716   (folding-mode-add-find-file-hook)
2717   (add-hook 'finder-mode-hook 'folding-mode)
2718   (or (memq 'folding-mode-write-file write-file-hooks)
2719       (add-hook 'write-file-hooks 'folding-mode-write-file 'end)))
2720
2721 ;;;###autoload
2722 (defun folding-keep-hooked ()
2723   "Make sure hooks are in their places."
2724   (unless (folding-is-hooked)
2725     (folding-uninstall-hooks)
2726     (folding-install-hooks)))
2727
2728 ;;}}}
2729 ;;{{{ code: Mouse handling
2730
2731 (defun folding-mouse-call-original (&optional event)
2732   "Execute original mouse function using mouse EVENT.
2733
2734 Do nothing if original function does not exist.
2735
2736 Does nothing when called by a function which has earlier been called
2737 by us.
2738
2739 Sets global:
2740   `folding-calling-original'"
2741   (interactive "@e") ;; Was "e"
2742   ;; Without the following test we could easily end up in a endless
2743   ;; loop in case we would call a function which would call us.
2744   ;;
2745   ;; (An easy constructed example is to bind the function
2746   ;; `folding-mouse-context-sensitive' to the same mouse button both in
2747   ;; `folding-mode-map' and in the global map.)
2748   (if folding-calling-original
2749       nil
2750     ;; `folding-calling-original' is global
2751     (setq folding-calling-original t)
2752     (unwind-protect
2753         (progn
2754           (or event
2755               (setq event last-input-event))
2756           (let (mouse-key)
2757             (cond
2758              ((not folding-xemacs-p)
2759               (setq mouse-key (make-vector 1 (car-safe event))))
2760              (folding-xemacs-p
2761               (setq mouse-key
2762                     (vector
2763                      (append
2764                       (event-modifiers event)
2765                       (list (intern
2766                              (format "button%d"
2767                                      (funcall
2768                                       (symbol-function 'event-button)
2769                                       event))))))))
2770              (t
2771               (error "This version of Emacs can't handle events.")))
2772             ;; Test string: http://www.csd.uu.se/~andersl
2773             ;;              andersl A T csd uu se
2774             ;; (I have `ark-goto-url' bound to the same key as
2775             ;; this function.)
2776             ;;
2777             ;; turn off folding, so that we can see the real
2778             ;; function behind it.
2779             ;;
2780             ;; We have to restore the current buffer, otherwise the
2781             ;; let* won't be able to restore the old value of
2782             ;; folding-mode. In my environment, I have bound a
2783             ;; function which starts mail when I click on an e-mail
2784             ;; address. When returning, the current buffer has
2785             ;; changed.
2786             (let* ((folding-mode nil)
2787                    (orig-buf (current-buffer))
2788                    (orig-func (key-binding mouse-key)))
2789               ;; call only if exist
2790               (when orig-func
2791                 ;; Check if the original function has arguments. If
2792                 ;; it does, call it with the event as argument.
2793                 (unwind-protect
2794                     (progn
2795                       (setq this-command orig-func)
2796                       (call-interactively orig-func))
2797 ;;; #untested, but included here for further reference
2798 ;;;                 (cond
2799 ;;;                  ((not (string-match "mouse" (symbol-name orig-func)))
2800 ;;;                   (call-interactively orig-func))
2801 ;;;                     ((string-match "^mouse" (symbol-name orig-func))
2802 ;;;                      (funcall orig-func event))
2803 ;;;                     (t
2804 ;;;                      ;;  Some other package's mouse command,
2805 ;;;                      ;;  should we do something special here for
2806 ;;;                      ;;  somebody?
2807 ;;;                      (funcall orig-func event)))
2808                   (set-buffer orig-buf))))))
2809       ;; This is always executed, even if the above generates an error.
2810       (setq folding-calling-original nil))))
2811
2812 (defun folding-mouse-context-sensitive (event)
2813   "Perform some operation depending on the context of the mouse pointer.
2814 EVENT is mouse event.
2815
2816 The variable `folding-behave-table' contains a mapping between contexts and
2817 operations to perform.
2818
2819 The following contexts can be handled (They are named after the
2820 natural operation to perform on them):
2821
2822     open   -   A folded fold.
2823     close  -   An open fold, which isn't the one current topmost one.
2824     up     -   The topmost visible fold.
2825     other  -   Anything else.
2826
2827 Note that the `pointer' can be either the buffer point, or the mouse
2828 pointer depending in the setting of the user option
2829 `folding-mouse-yank-at-point'."
2830   (interactive "e")
2831   (let* ( ;;  - Get mouse cursor point, or point
2832          (point (folding-mouse-point event))
2833          state)
2834     (if (null point)
2835         ;; The user didn't click on any text.
2836         (folding-act 'other event)
2837       (save-excursion
2838         (goto-char point)
2839         (setq state (folding-mark-look-at)))
2840       (cond
2841        ((eq state 0)
2842         (folding-act 'open event))
2843        ((eq state 1)
2844         (folding-act 'close event))
2845        ((eq state 11)
2846         (folding-act 'up event))
2847        ((eq 'end state)
2848         (folding-act 'close))
2849        ((eq state 'end-in)
2850         (folding-act 'up event))
2851        (t
2852         (folding-act 'other event))))))
2853
2854 ;;; FIXME: #not used, the pick move handles this too
2855 (defun folding-mouse-move (event)
2856   "Move down if sitting on fold mark using mouse EVENT.
2857
2858 Original function behind the mouse is called if no FOLD action wasn't
2859 taken."
2860   (interactive "e")
2861   (let* ( ;;  - Get mouse cursor point, or point
2862          (point (folding-mouse-point event))
2863          state)
2864     (save-excursion
2865       (goto-char point)
2866       (beginning-of-line)
2867       (setq state (folding-mark-look-at)))
2868     (cond
2869      ((not (null state))
2870       (goto-char point)
2871       (folding-next-visible-heading) t)
2872      (t
2873       (folding-mouse-call-original event)))))
2874
2875 (defun folding-mouse-pick-move (event)
2876   "Pick movement if sitting on beg/end fold mark using mouse EVENT.
2877 If mouse if at the `beginning-of-line' point, then always move up.
2878
2879 Original function behind the mouse is called if no FOLD action wasn't
2880 taken."
2881   (interactive "e")
2882   (let* ( ;;  - Get mouse cursor point, or point
2883          (point (folding-mouse-point event))
2884          state)
2885     (save-excursion
2886       (goto-char point)
2887       (setq state (folding-mark-look-at)))
2888     (cond
2889      ((not (null state))
2890       (goto-char point)
2891       (if (= point
2892              (save-excursion (beginning-of-line) (point)))
2893           (folding-previous-visible-heading)
2894         (folding-pick-move)))
2895      (t
2896       (folding-mouse-call-original event)))))
2897
2898 ;;}}}
2899 ;;{{{ code: engine
2900
2901 (defun folding-set-mode-line ()
2902   "Update modeline with fold level."
2903   (if (null folding-stack)
2904       (kill-local-variable 'folding-mode-string)
2905     (make-local-variable 'folding-mode-string)
2906     (setq folding-mode-string
2907           (if (eq 'folded (car folding-stack))
2908               (concat
2909                folding-inside-string "1" folding-inside-mode-name)
2910             (concat
2911              folding-inside-string
2912              (int-to-string (length folding-stack))
2913              folding-inside-mode-name)))))
2914
2915 (defun folding-clear-stack ()
2916   "Clear the fold stack, and release all the markers it refers to."
2917   (let ((stack folding-stack))
2918     (setq folding-stack nil)
2919     (while (and stack (not (eq 'folded (car stack))))
2920       (set-marker (car (car stack)) nil)
2921       (set-marker (cdr (car stack)) nil)
2922       (setq stack (cdr stack)))))
2923
2924 (defun folding-check-if-folding-allowed ()
2925   "Return non-nil when buffer allowed to be folded automatically.
2926 When buffer is loaded it may not be desirable to fold it immediately,
2927 because the file may be too large, or it may contain fold marks, that
2928 really are not _real_ folds. (Eg. RMAIL saved files may have the
2929 marks)
2930
2931 This function returns t, if it's okay to proceed checking the fold status
2932 of file. Returning nil means that folding should not touch this file.
2933
2934 The variable `folding-check-allow-folding-function' normally contains this
2935 function. Change the variable to use your own scheme."
2936
2937   (or (let ((file (get 'find-file-noselect 'folding)))
2938         ;;  When a file reference is "pushed" is a C-h v buffer that says:
2939         ;;  test is a Lisp function in `~/foo/tmp/test.el' A flag gets set
2940         ;;  (see adviced code) and we must not fold this buffer, because
2941         ;;  it will be immediately searched.
2942         (and file
2943              (not (string-match (regexp-quote file)
2944                                 (or buffer-file-name "")))))
2945       ;;  Do not fold these files
2946       (null (string-match folding-mode-hook-no-regexp (buffer-name)))))
2947
2948 (defun folding-mode-find-file ()
2949   "One of the funcs called whenever a `find-file' is successful.
2950 It checks to see if `folded-file' has been set as a buffer-local
2951 variable, and automatically starts Folding mode if it has.
2952
2953 This allows folded files to be automatically folded when opened.
2954
2955 To make this hook effective, the symbol `folding-mode-find-file-hook'
2956 should be placed at the end of `find-file-hooks'. If you have
2957 some other hook in the list, for example a hook to automatically
2958 uncompress or decrypt a buffer, it should go earlier on in the list.
2959
2960 See also `folding-mode-add-find-file-hook'."
2961   (let* ((check-fold folding-check-folded-file-function)
2962          (allow-fold folding-check-allow-folding-function))
2963     ;;  Turn mode on only if it's allowed
2964     (if (funcall allow-fold)
2965         (or (and (and check-fold (funcall check-fold))
2966                  (folding-mode 1))
2967             (and (assq 'folded-file (buffer-local-variables))
2968                  folded-file
2969                  (folding-mode 1)
2970                  (kill-local-variable 'folded-file)))
2971       ;; In all other cases, unfold buffer.
2972       (if folding-mode
2973           (folding-mode -1)))))
2974
2975 ;;;###autoload
2976 (defun folding-mode-add-find-file-hook ()
2977   "Append `folding-mode-find-file-hook' to the list `find-file-hooks'.
2978
2979 This has the effect that afterwards, when a folded file is visited, if
2980 appropriate Emacs local variable entries are recognized at the end of
2981 the file, Folding mode is started automatically.
2982
2983 If `inhibit-local-variables' is non-nil, this will not happen regardless
2984 of the setting of `find-file-hooks'.
2985
2986 To declare a file to be folded, put `folded-file: t' in the file's
2987 local variables. eg., at the end of a C source file, put:
2988
2989 /*
2990 Local variables:
2991 folded-file: t
2992 */
2993
2994 The local variables can be inside a fold."
2995   (interactive)
2996   (or (memq 'folding-mode-find-file find-file-hooks)
2997       (add-hook 'find-file-hooks 'folding-mode-find-file 'end)))
2998
2999 (defun folding-mode-write-file ()
3000   "Folded files must be controlled by folding before saving.
3001 This function turns on the folding mode if it is not activated.
3002 It prevents 'binary pollution' upon save."
3003   (let* ((check-func  folding-check-folded-file-function)
3004          (no-re      folding-mode-hook-no-regexp)
3005          (bn         (or (buffer-name) "")))
3006     (if (and (not       (string-match no-re bn))
3007              (boundp    'folding-mode)
3008              (null      folding-mode)
3009              (and check-func (funcall check-func)))
3010         (progn
3011           ;;  When folding mode is turned on it also 'folds' whole
3012           ;;  buffer... can't avoid that, since it's more important
3013           ;;  to save safely
3014           (folding-mode 1)))
3015     ;; hook returns nil, good habit
3016     nil))
3017
3018 (defun folding-check-folded ()
3019   "Function to determine if this file is in folded form."
3020   (let* ( ;;  Could use folding-top-regexp , folding-bottom-regexp ,
3021          ;;  folding-regexp But they are not available at load time.
3022          (folding-re1 "^.?.?.?{{{")
3023          (folding-re2 "[\r\n].*}}}"))
3024     (save-excursion
3025       (goto-char (point-min))
3026       ;;  If we found both, we assume file is folded
3027       (and (re-search-forward folding-re1 nil t)
3028            ;; if file is folded, there are \r's
3029            (search-forward "\r" nil t)
3030            (re-search-forward folding-re2 nil t)))))
3031
3032 ;;}}}
3033
3034 ;;{{{ code: Folding mode
3035
3036 (defun folding-font-lock-keywords (&optional mode)
3037   "Return folding font-lock keywords for MODE."
3038   ;;  Add support mode-by-mode basis. Check if mode is already
3039   ;;  handled from the property list.
3040   (destructuring-bind (beg end ignore)
3041       (folding-get-mode-marks (or mode major-mode))
3042     (setq beg (concat "^[ \t]*" (regexp-quote beg) "[^\r\n]+"))
3043     (setq end (concat "^[ \t]*" (regexp-quote end)))
3044     (list
3045      ;;  the `t' says to overwrite any previous highlight.
3046      ;;  => Needed because folding marks are in comments.
3047      (list beg 0 folding-font-lock-begin-mark  t)
3048      (list end 0 folding-font-lock-end-mark t))))
3049
3050 (defun folding-font-lock-support-instantiate (&optional mode)
3051   "Add fold marks with `font-lock-add-keywords'."
3052   (or mode
3053       (setq mode major-mode))
3054   ;;  Hide function from Byte Compiler.
3055   (let ((function 'font-lock-add-keywords))
3056     (when (fboundp function)
3057       (funcall function
3058                mode
3059                (folding-font-lock-keywords mode))
3060       ;; In order to see new keywords font lock must be restarted.
3061       (dolist (buffer (buffer-list))
3062         (with-current-buffer buffer
3063           (when (and (eq major-mode mode)
3064                      (or font-lock-mode
3065                          ;;  Hide variable from byte compiler.
3066                          (let ((sym 'global-font-lock-mode))
3067                            (and (boundp sym)
3068                                 (symbol-value sym)))))
3069             ;; FIXME: should we use font-lock-fontify-buffer instead?
3070             (font-lock-mode -1)
3071             (font-lock-mode 1)))))))
3072
3073 (defun folding-font-lock-support ()
3074   "Add font lock support."
3075   (let ((list (get 'folding-mode 'font-lock)))
3076     (unless (memq major-mode list)
3077       ;;  Support added, update known list
3078       (push major-mode list)
3079       (put 'folding-mode 'font-lock list)
3080       (folding-font-lock-support-instantiate major-mode))))
3081
3082 (defun folding-set-local-variables ()
3083   "Set local fold mark variables.
3084 If you're going to change the beginning and end mark in
3085 `folding-mode-marks-alist'; you must call this function."
3086   (set (make-local-variable 'folding-stack) nil)
3087   (make-local-variable 'folding-top-mark)
3088   (make-local-variable 'folding-secondary-top-mark)
3089   (make-local-variable 'folding-top-regexp)
3090   (make-local-variable 'folding-bottom-mark)
3091   (make-local-variable 'folding-bottom-regexp)
3092   (make-local-variable 'folding-regexp)
3093   (or (and (boundp 'folding-top-regexp)
3094            folding-top-regexp
3095            (boundp 'folding-bottom-regexp)
3096            folding-bottom-regexp)
3097       (let ((folding-marks (assq major-mode
3098                                  folding-mode-marks-alist)))
3099         (if folding-marks
3100             (setq folding-marks (cdr folding-marks))
3101           (setq folding-marks '("{{{" "}}}")))
3102         (apply 'folding-set-marks folding-marks))))
3103
3104 ;;;###autoload
3105 (defun turn-off-folding-mode ()
3106   "Turn off folding."
3107   (folding-mode -1))
3108
3109 ;;;###autoload
3110 (defun turn-on-folding-mode ()
3111   "Turn on folding."
3112   (folding-mode 1))
3113
3114 ;;;###autoload
3115 (defun folding-mode (&optional arg inter)
3116   "A folding-editor-like minor mode. ARG INTER.
3117
3118 These are the basic commands that Folding mode provides:
3119
3120 \\{folding-mode-map}
3121
3122 Keys starting with `folding-mode-prefix-key'
3123
3124 \\{folding-mode-prefix-map}
3125
3126      folding-convert-buffer-for-printing:
3127      `\\[folding-convert-buffer-for-printing]'
3128      Makes a ready-to-print, formatted, unfolded copy in another buffer.
3129
3130      Read the documentation for the above functions for more information.
3131
3132 Overview
3133
3134     Folds are a way of hierarchically organizing the text in a file, so
3135     that the text can be viewed and edited at different levels. It is
3136     similar to Outline mode in that parts of the text can be hidden from
3137     view. A fold is a region of text, surrounded by special \"fold marks\",
3138     which act like brackets, grouping the text. Fold mark pairs can be
3139     nested, and they can have titles. When a fold is folded, the text is
3140     hidden from view, except for the first line, which acts like a title
3141     for the fold.
3142
3143     Folding mode is a minor mode, designed to cooperate with many other
3144     major modes, so that many types of text can be folded while they are
3145     being edited (eg., plain text, program source code, Texinfo, etc.).
3146
3147 Folding-mode function
3148
3149     If Folding mode is not called interactively (`(interactive-p)' is nil),
3150     and it is called with two or less arguments, all of which are nil, then
3151     the point will not be altered if `folding-folding-on-startup' is set
3152     and `folding-whole-buffer' is called. This is generally not a good
3153     thing, as it can leave the point inside a hidden region of a fold, but
3154     it is required if the local variables set \"mode: folding\" when the
3155     file is first read (see `hack-local-variables').
3156
3157     Not that you should ever want to, but to call Folding mode from a
3158     program with the default behavior (toggling the mode), call it with
3159     something like `(folding-mode nil t)'.
3160
3161 Fold marks
3162
3163     For most types of folded file, lines representing folds have \"{{{\"
3164     near the beginning. To enter a fold, move the point to the folded line
3165     and type `\\[folding-shift-in]'. You should no longer be able to see
3166     the rest of the file, just the contents of the fold, which you couldn't
3167     see before. You can use `\\[folding-shift-out]' to leave a fold, and
3168     you can enter and exit folds to move around the structure of the file.
3169
3170     All of the text is present in a folded file all of the time. It is just
3171     hidden. Folded text shows up as a line (the top fold mark) with \"...\"
3172     at the end. If you are in a fold, the mode line displays \"inside n
3173     folds Narrow\", and because the buffer is narrowed you can't see outside
3174     of the current fold's text.
3175
3176     By arranging sections of a large file in folds, and maybe subsections
3177     in sub-folds, you can move around a file quickly and easily, and only
3178     have to scroll through a couple of pages at a time. If you pick the
3179     titles for the folds carefully, they can be a useful form of
3180     documentation, and make moving though the file a lot easier. In
3181     general, searching through a folded file for a particular item is much
3182     easier than without folds.
3183
3184 Managing folds
3185
3186     To make a new fold, set the mark at one end of the text you want in the
3187     new fold, and move the point to the other end. Then type
3188     `\\[folding-fold-region]'. The text you selected will be made into a
3189     fold, and the fold will be entered. If you just want a new, empty fold,
3190     set the mark where you want the fold, and then create a new fold there
3191     without moving the point. Don't worry if the point is in the middle of
3192     a line of text, `folding-fold-region' will not break text in the middle
3193     of a line. After making a fold, the fold is entered and the point is
3194     positioned ready to enter a title for the fold. Do not delete the fold
3195     marks, which are usually something like \"{{{\" and \"}}}\". There may
3196     also be a bit of fold mark which goes after the fold title.
3197
3198     If the fold markers get messed up, or you just want to see the whole
3199     unfolded file, use `\\[folding-open-buffer]' to unfolded the whole
3200     file, so you can see all the text and all the marks. This is useful for
3201     checking/correcting unbalanced fold markers, and for searching for
3202     things. Use `\\[folding-whole-file]' to fold the buffer again.
3203
3204     `folding-shift-out' will attempt to tidy the current fold just before
3205     exiting it. It will remove any extra blank lines at the top and bottom,
3206     \(outside the fold marks). It will then ensure that fold marks exists,
3207     and if they are not, will add them (after asking). Finally, the number
3208     of blank lines between the fold marks and the contents of the fold is
3209     set to 1 (by default).
3210
3211 Folding package customizations
3212
3213     If the fold marks are not set on entry to Folding mode, they are set to
3214     a default for current major mode, as defined by
3215     `folding-mode-marks-alist' or to \"{{{ \" and \"}}}\" if none are
3216     specified.
3217
3218     To bind different commands to keys in Folding mode, set the bindings in
3219     the keymap `folding-mode-map'.
3220
3221     The hooks `folding-mode-hook' and `<major-mode-name>-folding-hook' are
3222     called before folding the buffer and applying the key bindings in
3223     `folding-mode-map'. This is a good hook to set extra or different key
3224     bindings in `folding-mode-map'. Note that key bindings in
3225     `folding-mode-map' are only examined just after calling these hooks;
3226     new bindings in those maps only take effect when Folding mode is being
3227     started. The hook `folding-load-hook' is called when Folding mode is
3228     loaded into Emacs.
3229
3230 Mouse behavior
3231
3232     If you want folding to detect point of actual mouse click, please see
3233     variable `folding-mouse-yank-at-p'.
3234
3235     To customise the mouse actions, look at `folding-behave-table'."
3236   (interactive)
3237
3238   (let ((new-folding-mode
3239          (if (not arg)
3240              (not folding-mode)
3241            (> (prefix-numeric-value arg) 0))))
3242     (or (eq new-folding-mode
3243             folding-mode)
3244         (if folding-mode
3245             (progn
3246               ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ progn ^^^
3247               ;; turn off folding
3248               (if (null (folding-use-overlays-p))
3249                   (setq selective-display nil))
3250               (folding-clear-stack)
3251               (folding-narrow-to-region nil nil)
3252               (folding-subst-regions (list 1 (point-max)) ?\r ?\n)
3253
3254               ;; Restore "%n" (Narrow) in the mode line
3255               (setq mode-line-format
3256                     (mapcar
3257                      (function
3258                       (lambda (item)
3259                         (if (equal item 'folding-narrow-placeholder)
3260                             "%n" item)))
3261                      mode-line-format)))
3262           ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ else ^^^
3263           (cond
3264            ((folding-use-overlays-p)
3265             ;;  This may be Emacs specific; how about XEmacs?
3266             ;;
3267             ;; make line-move-ignore-invisible buffer local, matches
3268             ;; outline.el, and the 21 pre-release gets upset if this is
3269             ;; defined globally in shell buffer...
3270             (make-local-variable 'line-move-ignore-invisible)
3271             (setq  line-move-ignore-invisible t
3272                    buffer-invisibility-spec   '((t . t))))
3273            (t
3274             (setq selective-display t)
3275             (setq selective-display-ellipses t)))
3276           (unless (assq 'folding-mode minor-mode-alist)
3277             ;;  User has not run folding-install or he did call
3278             ;;  folding-uninstall which completely wiped package out.
3279             ;;  => anyway now he calls us, so be there for him
3280             (folding-install))
3281           (folding-keep-hooked)         ;set hooks if not there
3282           (widen)
3283           (setq folding-narrow-overlays nil)
3284           (folding-set-local-variables)
3285           (folding-font-lock-support)
3286           (unwind-protect
3287               (let ((hook-symbol (intern-soft
3288                                   (concat
3289                                    (symbol-name major-mode)
3290                                    "-folding-hook"))))
3291                 (run-hooks 'folding-mode-hook)
3292                 (and hook-symbol
3293                      (run-hooks hook-symbol)))
3294             (folding-set-mode-line))
3295           (and folding-folding-on-startup
3296                (if (or (interactive-p)
3297                        arg
3298                        inter)
3299                    (folding-whole-buffer)
3300                  (save-excursion
3301                    (folding-whole-buffer))))
3302           (folding-narrow-to-region nil nil t)
3303           ;; Remove "%n" (Narrow) from the mode line
3304           (setq mode-line-format
3305                 (mapcar
3306                  (function
3307                   (lambda (item)
3308                     (if (equal item "%n")
3309                         'folding-narrow-placeholder item)))
3310                  mode-line-format))))
3311     (setq folding-mode new-folding-mode)
3312     (if folding-mode
3313         (easy-menu-add folding-mode-menu)
3314       (easy-menu-remove folding-mode-menu))))
3315
3316 ;;}}}
3317 ;;{{{ code: setting fold marks
3318
3319 ;; You think those "\\(\\)" pairs are peculiar?  Me too. Emacs regexp
3320 ;; stuff has a bug; sometimes "\\(.*\\)" fails when ".*" succeeds, but
3321 ;; only in a folded file!  Strange bug!  Must check it out sometime.
3322
3323 (defun folding-set-marks (top bottom &optional secondary)
3324   "Set the folding top and bottom mark for the current buffer.
3325
3326 Input:
3327
3328   TOP           The topmost fold mark. Comment start + fold begin string.
3329   BOTTOM        The bottom fold mark Comment end + fold end string.
3330   SECONDARY     Usually the comment end indicator for the mode. This
3331                 is inserted by `folding-fold-region' after the fold top mark,
3332                 and is presumed to be put after the title of the fold.
3333
3334 Example:
3335
3336    html-mode:
3337
3338       top: \"<!-- [[[ \"
3339       bot: \"<!-- ]]] -->\"
3340       sec: \" -->\"
3341
3342 Notice that the top marker needs to be closed with SECONDARY comment end string.
3343
3344 Various regular expressions are set with this function, so don't set the
3345 mark variables directly."
3346   (set (make-local-variable 'folding-top-mark)
3347        top)
3348   (set (make-local-variable 'folding-bottom-mark)
3349        bottom)
3350   (set (make-local-variable 'folding-secondary-top-mark)
3351        secondary)
3352   (set (make-local-variable 'folding-top-regexp)
3353        (concat "\\(^\\|\r+\\)[ \t]*"
3354                (regexp-quote folding-top-mark)))
3355   (set (make-local-variable 'folding-bottom-regexp)
3356        (concat "\\(^\\|\r+\\)[ \t]*"
3357                (regexp-quote folding-bottom-mark)))
3358   (set (make-local-variable 'folding-regexp)
3359        (concat "\\(^\\|\r\\)\\([ \t]*\\)\\(\\("
3360                (regexp-quote folding-top-mark)
3361                "\\)\\|\\("
3362                (regexp-quote folding-bottom-mark)
3363                "[ \t]*\\(\\)\\($\\|\r\\)\\)\\)")))
3364
3365 ;;}}}
3366 ;;{{{ code: movement
3367
3368 (defun folding-next-visible-heading (&optional direction)
3369   "Move up/down fold headers.
3370 Backward if DIRECTION is non-nil returns nil if not moved = no next marker."
3371   (interactive)
3372   (let* ((begin-mark (nth 0 (folding-get-mode-marks)))
3373          case-fold-search)
3374     (if direction
3375         (re-search-backward (concat "^" (regexp-quote begin-mark)) nil t)
3376       (re-search-forward  (concat "^" (regexp-quote begin-mark)) nil t))))
3377
3378 (defun folding-previous-visible-heading ()
3379   "Move upward fold headers."
3380   (interactive)
3381   (beginning-of-line)
3382   (folding-next-visible-heading 'backward))
3383
3384 (defun folding-find-folding-mark (&optional end-fold)
3385   "Search backward to find beginning fold. Skips subfolds.
3386 Optionally searches forward to find END-FOLD mark.
3387
3388 Return:
3389
3390   nil
3391   point     position of fold mark"
3392   (let* (case-fold-search
3393          (elt   (folding-get-mode-marks))
3394          (bm    (regexp-quote (nth 0 elt))) ; markers defined for mode
3395          (em    (regexp-quote (nth 1 elt))) ; markers defined for mode
3396          (re    (concat "^" bm "\\|^" em))
3397          (count 0)
3398          stat
3399          moved)
3400     (save-excursion
3401       (cond
3402        (end-fold
3403         (folding-end-of-line)
3404         ;; We must skip over inner folds
3405         (while (and (null moved)
3406                     (re-search-forward re nil t))
3407           (setq stat (folding-mark-look-at))
3408           (cond
3409            ((symbolp stat)
3410             (setq count (1- count))
3411             (if (< count 0)           ;0 or less means no middle folds
3412                 (setq moved t)))
3413            ((memq stat '(1 11))         ;BEG fold
3414             (setq count (1+ count)))))  ;; end while
3415         (when moved
3416           (forward-char -3)
3417           (setq moved (point))))
3418        (t
3419         (while (and (null moved)
3420                     (re-search-backward  re nil t))
3421           (setq stat (folding-mark-look-at))
3422           (cond
3423            ((memq stat '(1 11))
3424             (setq count (1- count))
3425             (if (< count 0)           ;0 or less means no middle folds
3426                 (setq moved (point))))
3427            ((symbolp stat)
3428             (setq count (1+ count)))))
3429         (when moved                     ;What's the result
3430           (forward-char 3)
3431           (setq moved (point))))))
3432     moved))
3433
3434 (defun folding-pick-move ()
3435   "Pick the logical movement on fold mark.
3436 If at the end of fold, then move to the beginning and vice versa.
3437
3438 If placed over closed fold moves to the next fold. When no next
3439 folds are visible, stops moving.
3440
3441 Return:
3442  t      if moved"
3443   (interactive)
3444   (let* (case-fold-search
3445          (elt   (folding-get-mode-marks))
3446          (bm    (nth 0 elt))            ; markers defined for mode
3447          (stat  (folding-mark-look-at))
3448          moved)
3449     (cond
3450      ((eq 0 stat)                       ;closed fold
3451       (when (re-search-forward  (concat "^" (regexp-quote bm)) nil t)
3452         (setq moved t)
3453         (forward-char 3)))
3454      ((symbolp stat)                    ;End fold
3455       (setq moved (folding-find-folding-mark)))
3456      ((integerp stat)                   ;Beg fold
3457       (setq moved (folding-find-folding-mark 'end-fold))))
3458     (if (integerp moved)
3459         (goto-char moved))
3460     moved))
3461
3462 ;;; Idea by Scott Evans <gse A T antisleep com>
3463 (defun folding-context-next-action ()
3464   "Take next action according to point and context.
3465 If point is at:
3466
3467   Begin Fold  :  toggle open - close
3468   End Fold    :  close
3469   inside      :  fold current level."
3470   (interactive)
3471   (let ((state (folding-mark-look-at)))
3472     (cond
3473      ((eq state 0)
3474       (folding-act 'open))
3475      ((eq state 1)
3476       (folding-act 'close))
3477      ((eq state 11)
3478       (folding-act 'up))
3479      ((eq 'end state)
3480       (folding-act 'close))
3481      ((eq state 'end-in)
3482       (folding-act 'up))
3483      (t
3484       (folding-act 'other)))))
3485
3486 (defun folding-forward-char-1 (&optional arg)
3487   "See `folding-forward-char-1' for ARG."
3488   (if (eq arg 1)
3489       ;; Do it a faster way for arg = 1.
3490       (if (eq (following-char) ?\r)
3491           (let ((saved (point))
3492                 (inhibit-quit t))
3493             (end-of-line)
3494             (if (not (eobp))
3495                 (forward-char)
3496               (goto-char saved)
3497               (error "End of buffer")))
3498         ;; `forward-char' here will do its own error if (eobp).
3499         (forward-char))
3500     (if (> 0 (or arg (setq arg 1)))
3501         (folding-backward-char (- arg))
3502       (let (goal saved)
3503         (while (< 0 arg)
3504           (skip-chars-forward "^\r" (setq goal (+ (point) arg)))
3505           (if (eq goal (point))
3506               (setq arg 0)
3507             (if (eobp)
3508                 (error "End of buffer")
3509               (setq arg (- goal 1 (point))
3510                     saved (point))
3511               (let ((inhibit-quit t))
3512                 (end-of-line)
3513                 (if (not (eobp))
3514                     (forward-char)
3515                   (goto-char saved)
3516                   (error "End of buffer"))))))))))
3517
3518 (defmacro folding-forward-char-macro ()
3519   `(defun folding-forward-char (&optional arg)
3520      "Move point right ARG characters, skipping hidden folded regions.
3521 Moves left if ARG is negative. On reaching end of buffer, stop and
3522 signal error."
3523      ,(folding-interactive-spec-p)
3524      ;; (folding-preserve-active-region)
3525      (folding-forward-char-1 arg)))
3526
3527 (folding-forward-char-macro)
3528
3529 (defun folding-backward-char-1 (&optional arg)
3530   "See `folding-backward-char-1' for ARG."
3531   (if (eq arg 1)
3532       ;; Do it a faster way for arg = 1.
3533       ;; Catch the case where we are in a hidden region, and bump into a \r.
3534       (if (or (eq (preceding-char) ?\n)
3535               (eq (preceding-char) ?\r))
3536           (let ((pos (1- (point)))
3537                 (inhibit-quit t))
3538             (forward-char -1)
3539             (beginning-of-line)
3540             (skip-chars-forward "^\r" pos))
3541         (forward-char -1))
3542     (if (> 0 (or arg (setq arg 1)))
3543         (folding-forward-char (- arg))
3544       (let (goal)
3545         (while (< 0 arg)
3546           (skip-chars-backward "^\r\n" (max (point-min)
3547                                             (setq goal (- (point) arg))))
3548           (if (eq goal (point))
3549               (setq arg 0)
3550             (if (bobp)
3551                 (error "Beginning of buffer")
3552               (setq arg (- (point) 1 goal)
3553                     goal (point))
3554               (let ((inhibit-quit t))
3555                 (forward-char -1)
3556                 (beginning-of-line)
3557                 (skip-chars-forward "^\r" goal)))))))))
3558
3559 (defmacro folding-backward-char-macro ()
3560   `(defun folding-backward-char (&optional arg)
3561      "Move point right ARG characters, skipping hidden folded regions.
3562 Moves left if ARG is negative. On reaching end of buffer, stop and
3563 signal error."
3564      ,(folding-interactive-spec-p)
3565      ;; (folding-preserve-active-region)
3566      (folding-backward-char-1 arg)))
3567
3568 (folding-backward-char-macro)
3569
3570 (defmacro folding-end-of-line-macro ()
3571   `(defun folding-end-of-line (&optional arg)
3572      "Move point to end of current line, but before hidden folded region.
3573 ARG is line count.
3574
3575 Has the same behavior as `end-of-line', except that if the current line
3576 ends with some hidden folded text (represented by an ellipsis), the
3577 point is positioned just before it. This prevents the point from being
3578 placed inside the folded text, which is not normally useful."
3579      ,(folding-interactive-spec-p)
3580      ;;(interactive "p")
3581      ;; (folding-preserve-active-region)
3582      (if (or (eq arg 1)
3583              (not arg))
3584          (beginning-of-line)
3585        ;; `forward-line' also moves point to beginning of line.
3586        (forward-line (1- arg)))
3587      (skip-chars-forward "^\r\n")))
3588
3589 (folding-end-of-line-macro)
3590
3591 (defun folding-skip-ellipsis-backward ()
3592   "Move the point backwards out of folded text.
3593
3594 If the point is inside a folded region, the cursor is displayed at the
3595 end of the ellipsis representing the folded part. This function checks
3596 to see if this is the case, and if so, moves the point backwards until
3597 it is just outside the hidden region, and just before the ellipsis.
3598
3599 Returns t if the point was moved, nil otherwise."
3600   (interactive)
3601   (let ((pos (point))
3602         result)
3603     (save-excursion
3604       (beginning-of-line)
3605       (skip-chars-forward "^\r" pos)
3606       (or (eq pos (point))
3607           (setq pos (point)
3608                 result t)))
3609     (goto-char pos)
3610     result))
3611
3612 ;;}}}
3613
3614 ;;{{{ code: Moving in and out of folds
3615
3616 ;;{{{ folding-shift-in
3617
3618 (defun folding-shift-in (&optional noerror)
3619   "Open and enter the fold at or around the point.
3620
3621 Enters the fold that the point is inside, wherever the point is inside
3622 the fold, provided it is a valid fold with balanced top and bottom
3623 marks. Returns nil if the fold entered contains no sub-folds, t
3624 otherwise. If an optional argument NOERROR is non-nil, returns nil if
3625 there are no folds to enter, instead of causing an error.
3626
3627 If the point is inside a folded, hidden region (as represented by an
3628 ellipsis), the position of the point in the buffer is preserved, and as
3629 many folds as necessary are entered to make the surrounding text
3630 visible. This is useful after some commands eg., search commands."
3631   (interactive)
3632   (labels
3633       ((open-fold nil
3634                   (let ((data (folding-show-current-entry noerror t)))
3635                     (and data
3636                          (progn
3637                            (when folding-narrow-by-default
3638                              (setq folding-stack
3639                                    (if folding-stack
3640                                        (cons (cons (point-min-marker)
3641                                                    (point-max-marker))
3642                                              folding-stack)
3643                                      '(folded)))
3644                              (folding-set-mode-line))
3645                            (folding-narrow-to-region (car data) (nth 1 data)))))))
3646     (let ((goal (point)))
3647       (while (folding-skip-ellipsis-backward)
3648         (beginning-of-line)
3649         (open-fold)
3650         (goto-char goal))
3651       (when (not folding-narrow-by-default)
3652         (widen)))))
3653
3654 ;;}}}
3655 ;;{{{ folding-shift-out
3656
3657 (defun folding-shift-out (&optional event)
3658   "Exits the current fold with EVENT."
3659   (interactive)
3660   (if folding-stack
3661       (progn
3662         (folding-tidy-inside)
3663         (cond
3664          ((folding-use-overlays-p)
3665           (folding-subst-regions
3666            (list (overlay-end (car folding-narrow-overlays))
3667                  (overlay-start (cdr folding-narrow-overlays))) ?\n ?\r)
3668           ;; So point is correct in other windows.
3669           (goto-char (overlay-end (car folding-narrow-overlays))))
3670          (t
3671           (folding-subst-regions (list (point-min) (point-max)) ?\n ?\r)
3672           ;; So point is correct in other window
3673           (goto-char (point-min))))
3674
3675         (if (eq (car folding-stack) 'folded)
3676             (folding-narrow-to-region nil nil t)
3677           (folding-narrow-to-region
3678            (marker-position (car (car folding-stack)))
3679            (marker-position (cdr (car folding-stack))) t))
3680         (and (consp (car folding-stack))
3681              (set-marker (car (car folding-stack)) nil)
3682              (set-marker (cdr (car folding-stack)) nil))
3683         (setq folding-stack (cdr folding-stack)))
3684     (error "Outside all folds"))
3685   (folding-set-mode-line))
3686
3687 ;;}}}
3688 ;;{{{ folding-show-current-entry
3689
3690 (defun folding-show-current-entry (&optional event noerror noskip)
3691   "Opens the fold that the point is on, but does not enter it.
3692 EVENT and optional arg NOERROR means don't signal an error if there is
3693 no fold, just return nil. NOSKIP means don't jump out of a hidden
3694 region first.
3695
3696 Returns ((START END SUBFOLDS-P). START and END indicate the extents of
3697 the fold that was shown. If SUBFOLDS-P is non-nil, the fold contains
3698 subfolds."
3699   (interactive)
3700   (or noskip
3701       (folding-skip-ellipsis-backward))
3702   (let ((point (point))
3703         backward
3704         forward
3705         start
3706         end
3707         subfolds-not-p)
3708     (unwind-protect
3709         (or (and (integerp
3710                   (car-safe (setq backward (folding-skip-folds t))))
3711                  (integerp
3712                   (car-safe (setq forward (folding-skip-folds nil))))
3713                  (progn
3714                    (goto-char (car forward))
3715                    (skip-chars-forward "^\r\n")
3716                    (setq end (point))
3717                    (skip-chars-forward "\r\n")
3718                    (not (and folding-stack (eobp))))
3719                  (progn
3720                    (goto-char (car backward))
3721                    (skip-chars-backward "^\r\n")
3722                    (setq start (point))
3723                    (skip-chars-backward "\r\n")
3724                    (not (and folding-stack (bobp))))
3725                  (progn
3726                    (setq point start)
3727                    ;; Avoid holding the list through a GC.
3728                    (setq subfolds-not-p
3729                          (not (or (cdr backward)
3730                                   (cdr forward))))
3731                    (folding-subst-regions
3732                     (append backward (nreverse forward))
3733                     ?\r ?\n)
3734                    ;;  FIXME: this should be moved to font-lock:
3735                    ;;  - When fold is closed, the whole line (with code)
3736                    ;;    is treated as comment
3737                    ;;  - Fon-lock changes all fonts to `font-lock-comment-face'
3738                    ;;  - When you again open fold, all text is in color
3739                    ;;
3740                    ;;  => Font lock should stop at \r, and not use ".*"
3741                    ;;     which includes \r character
3742                    ;;  This is a workaround, not an efficient one
3743                    (if (or (and (boundp 'global-font-lock-mode)
3744                                 global-font-lock-mode)
3745                            font-lock-mode)
3746                        (font-lock-fontify-region start end))
3747                    (list start end (not subfolds-not-p))))
3748             (if noerror
3749                 nil
3750               (error "Not on a fold")))
3751       (goto-char point))))
3752
3753 ;;}}}
3754 ;;{{{ folding-hide-current-entry
3755
3756 (defun folding-toggle-enter-exit ()
3757   "Run `folding-shift-in' or `folding-shift-out'.
3758 This depends on current line's contents."
3759   (interactive)
3760   (beginning-of-line)
3761   (let ((current-line-mark (folding-mark-look-at)))
3762     (if (and (numberp current-line-mark)
3763              (= current-line-mark 0))
3764         (folding-shift-in)
3765       (folding-shift-out))))
3766
3767 (defun folding-toggle-show-hide ()
3768   "Run folding-show-current-entry or folding-hide-current-entry depending on current line's contents."
3769   (interactive)
3770   (beginning-of-line)
3771   (let ((current-line-mark (folding-mark-look-at)))
3772     (if (and (numberp current-line-mark)
3773              (= current-line-mark 0))
3774         (folding-show-current-entry)
3775       (folding-hide-current-entry))))
3776
3777 (defun folding-hide-current-entry (&optional event)
3778   "Close the fold around the point using EVENT.
3779 Undo effect of `folding-show-current-entry'."
3780   (interactive)
3781   (folding-skip-ellipsis-backward)
3782   (let (start end)
3783     (if (and (integerp (setq start (car-safe (folding-skip-folds t))))
3784              (integerp (setq end (car-safe (folding-skip-folds nil)))))
3785         (if (and folding-stack
3786                  (or (eq start (point-min))
3787                      (eq end (point-max))))
3788             ;;(error "Cannot hide current fold")
3789             (folding-shift-out)
3790           (goto-char start)
3791           (skip-chars-backward "^\r\n")
3792           (folding-subst-regions (list start end) ?\n ?\r))
3793       (error "Not on a fold"))))
3794
3795 ;;}}}
3796 ;;{{{ folding-show-all
3797
3798 (defun folding-show-all ()
3799   "Exits all folds, to the top level."
3800   (interactive)
3801   (while folding-stack
3802     (folding-shift-out)))
3803
3804 ;;}}}
3805 ;;{{{ folding-goto-line
3806
3807 (defun folding-goto-line (line)
3808   "Go to LINE, entering as many folds as possible."
3809   (interactive "NGoto line: ")
3810   (folding-show-all)
3811   (goto-char 1)
3812   (and (< 1 line)
3813        (re-search-forward "[\n\C-m]" nil 0 (1- line)))
3814   (let ((goal (point)))
3815     (while (prog2 (beginning-of-line)
3816                (folding-shift-in t)
3817              (goto-char goal))))
3818   (folding-narrow-to-region
3819    (and folding-narrow-by-default (point-min))
3820    (point-max) t))
3821
3822 ;;}}}
3823
3824 ;;}}}
3825 ;;{{{ code: Searching for fold boundaries
3826
3827 ;;{{{ folding-skip-folds
3828
3829 (defun folding-skip-folds (backward &optional outside)
3830   "Skips forward through the buffer (backward if BACKWARD is non-nil)
3831 until it finds a closing fold mark or the end of the buffer. The
3832 point is not moved. Jumps over balanced folding-mark pairs on the way.
3833 Returns t if the end of buffer was found in an unmatched folding-mark
3834 pair, otherwise a list.
3835
3836 If the point is actually on an fold start mark, the mark is ignored;
3837 if it is on an end mark, the mark is noted. This decision is
3838 reversed if BACKWARD is non-nil. If optional OUTSIDE is non-nil and
3839 BACKWARD is nil, either mark is noted.
3840
3841 The first element of the list is a position in the end of the closing
3842 fold mark if one was found, or nil. It is followed by (END START)
3843 pairs (flattened, not a list of pairs). The pairs indicating the
3844 positions of folds skipped over; they are positions in the fold
3845 marks, not necessarily at the ends of the fold marks. They are in
3846 the opposite order to that in which they were skipped. The point is
3847 left in a meaningless place. If going backwards, the pairs are
3848 \(START END) pairs, as the fold marks are scanned in the opposite
3849 order.
3850
3851 Works by maintaining the position of the top and bottom marks found
3852 so far. They are found separately using a normal string search for
3853 the fixed part of a fold mark (because it is faster than a regexp
3854 search if the string does not occur often outside of fold marks),
3855 checking that it really is a proper fold mark, then considering the
3856 earliest one found. The position of the other (if found) is
3857 maintained to avoid an unnecessary search at the next iteration."
3858   (let ((first-mark (if backward folding-bottom-mark folding-top-mark))
3859         (last-mark  (if backward folding-top-mark    folding-bottom-mark))
3860         (top-re     folding-top-regexp)
3861         (depth 0)
3862         pairs point
3863         temp
3864         start
3865         first
3866         last
3867         case-fold-search)
3868     ;; Ignore trailing space?
3869     (when nil
3870       (when (and (stringp first-mark)
3871                  (string-match "^\\(.*[^ ]+\\) +$"  first-mark))
3872         (setq first-mark (match-string 1 first-mark)))
3873       (when (and (stringp last-mark)
3874                  (string-match "^\\(.*[^ ]+\\) +$"  last-mark))
3875         (setq last-mark (match-string 1 last-mark)))
3876       (when (and (stringp top-re)
3877                  (string-match "^\\(.*[^ ]+\\) +$"  top-re))
3878         (setq top-re (match-string 1 top-re))))
3879     (save-excursion
3880       (skip-chars-backward "^\r\n")
3881       (unless outside
3882         (and (eq (preceding-char) ?\r)
3883              (forward-char -1))
3884         (if (looking-at top-re)
3885             (if backward
3886                 (setq last (match-end 1))
3887               (skip-chars-forward "^\r\n"))))
3888       (while (progn
3889                ;;  Find last first, prevents unnecessary searching
3890                ;;  for first.
3891                (setq point (point))
3892                (or last
3893                    (while (and (if backward
3894                                    (search-backward last-mark first t)
3895                                  (search-forward  last-mark first t))
3896                                (progn
3897                                  (setq temp (point))
3898                                  (goto-char (match-beginning 0))
3899                                  (skip-chars-backward " \t")
3900                                  (and (not
3901                                        (setq last
3902                                              (if (eq (preceding-char) ?\r)
3903                                                  temp
3904                                                (and (bolp) temp))))
3905                                       (goto-char temp)))))
3906                    (goto-char point))
3907                (or first
3908                    (while (and (if backward
3909                                    (search-backward first-mark last t)
3910                                  (search-forward  first-mark last t))
3911                                (progn
3912                                  (setq temp (point))
3913                                  (goto-char (match-beginning 0))
3914                                  (skip-chars-backward " \t")
3915                                  (and (not
3916                                        (setq first
3917                                              (if (eq (preceding-char) ?\r)
3918                                                  temp
3919                                                (and (bolp) temp))))
3920                                       (goto-char temp))))))
3921                ;;  Return value of conditional says whether to
3922                ;;  iterate again.
3923                (if (not last)
3924                    ;;  Return from this with the result.
3925                    (not (setq pairs (if first t (cons nil pairs))))
3926                  (if (and first
3927                           (if backward
3928                               (> first last)
3929                             (< first last)))
3930                      (progn
3931                        (goto-char first)
3932                        (if (eq 0 depth)
3933                            (setq start first
3934                                  first nil
3935                                  depth 1) ;; non-nil value, loop again.
3936                          (setq first nil
3937                                ;; non-nil value => loop again
3938                                depth (1+ depth))))
3939                    (goto-char last)
3940                    (if (eq 0 depth)
3941                        (not (setq pairs (cons last pairs)))
3942                      (or (< 0 (setq depth (1- depth)))
3943                          (setq pairs (cons last (cons start pairs))))
3944                      (setq last nil)
3945                      t)))))
3946       pairs)))
3947
3948 ;;}}}
3949
3950 ;;}}}
3951 ;;{{{ code: Functions that actually modify the buffer
3952
3953 ;;{{{ folding-fold-region
3954
3955 (defun folding-fold-region (start end)
3956   "Places fold mark at the beginning and end of a specified region.
3957 The region is specified by two arguments START and END. The point is
3958 left at a suitable place ready to insert the title of the fold.
3959
3960 The fold markers are intended according to mode."
3961   (interactive "r")
3962   (and (< end start)
3963        (setq start (prog1 end
3964                      (setq end start))))
3965   (setq end (set-marker (make-marker) end))
3966   (goto-char start)
3967   (beginning-of-line)
3968   (setq start (point))
3969   (insert-before-markers folding-top-mark)
3970   ;;  XEmacs latex-mode, after (tex-site), indents the whole
3971   ;;  fold 50 characters right. Don't do that.
3972   (unless (string-match "latex" (symbol-name major-mode))
3973     (indent-according-to-mode))
3974   (let ((saved-point (point)))
3975     (and folding-secondary-top-mark
3976          (insert-before-markers folding-secondary-top-mark))
3977     (insert-before-markers ?\n)
3978     (goto-char (marker-position end))
3979     (set-marker end nil)
3980     (and (not (bolp))
3981          (eq 0 (forward-line))
3982          (eobp)
3983          (insert ?\n))
3984     (insert folding-bottom-mark)
3985     (unless (string-match "latex" (symbol-name major-mode))
3986       (indent-according-to-mode))
3987     (insert ?\n)
3988     (setq folding-stack (if folding-stack
3989                             (cons (cons (point-min-marker)
3990                                         (point-max-marker))
3991                                   folding-stack)
3992                           '(folded)))
3993     (folding-narrow-to-region start (1- (point)))
3994     (goto-char saved-point)
3995     (folding-set-mode-line))
3996   (save-excursion (folding-tidy-inside)))
3997
3998 ;;}}}
3999 ;;{{{ folding-tidy-inside
4000
4001 ;; Note to self: The long looking code for checking and modifying those
4002 ;; blank lines is to make sure the text isn't modified unnecessarily.
4003 ;; Don't remove it again!
4004
4005 (defun folding-tidy-inside ()
4006   "Add or remove blank lines at the top and bottom of the current fold.
4007 Also adds fold marks at the top and bottom (after asking), if they are not
4008 there already. The amount of space left depends on the variable
4009 `folding-internal-margins', which is one by default."
4010   (interactive)
4011   (if buffer-read-only nil
4012     (let ()
4013 ;;;          (top-re       (if (string-match "^\\(.*\\) $"  folding-top-mark)
4014 ;;;                            (match-string 1 folding-top-mark)
4015 ;;;                          folding-top-mark))
4016       (if (folding-use-overlays-p)
4017           (goto-char (- (overlay-end (car folding-narrow-overlays)) 1))
4018         (goto-char (point-min)))
4019       (and (eolp)
4020            (progn (skip-chars-forward "\n\t ")
4021                   (delete-region (point-min) (point))))
4022       (and (if (let (case-fold-search) (folding-mark-look-at-top-mark-p))
4023                (progn (forward-line 1)
4024                       (and (eobp) (insert ?\n))
4025                       t)
4026              (and (y-or-n-p "Insert missing folding-top-mark? ")
4027                   (progn (insert (concat folding-top-mark
4028                                          "<Replaced missing fold top mark>"
4029                                          (or folding-secondary-top-mark "")
4030                                          "\n"))
4031                          t)))
4032            folding-internal-margins
4033            (<= 0 folding-internal-margins)
4034            (let* ((p1 (point))
4035                   (p2 (progn (skip-chars-forward "\n") (point)))
4036                   (p3 (progn (skip-chars-forward "\n\t ")
4037                              (skip-chars-backward "\t " p2) (point))))
4038              (if (eq p2 p3)
4039                  (or (eq p2 (setq p3 (+ p1 folding-internal-margins)))
4040                      (if (< p2 p3)
4041                          (newline (- p3 p2))
4042                        (delete-region p3 p2)))
4043                (delete-region p1 p3)
4044                (or (eq 0 folding-internal-margins)
4045                    (newline folding-internal-margins)))))
4046       (if (folding-use-overlays-p)
4047           (goto-char  (overlay-start (cdr folding-narrow-overlays)))
4048         (goto-char (point-max)))
4049       (and (bolp)
4050            (progn (skip-chars-backward "\n")
4051                   (delete-region (point) (point-max))))
4052       (beginning-of-line)
4053       (and (or (let (case-fold-search) (folding-mark-look-at-bottom-mark-p))
4054                (progn (goto-char (point-max)) nil)
4055                (and (y-or-n-p "Insert missing folding-bottom-mark? ")
4056                     (progn
4057                       (insert (concat "\n" folding-bottom-mark))
4058                       (beginning-of-line)
4059                       t)))
4060            folding-internal-margins
4061            (<= 0 folding-internal-margins)
4062            (let* ((p1 (point))
4063                   (p2 (progn (skip-chars-backward "\n") (point)))
4064                   (p3 (progn (skip-chars-backward "\n\t ")
4065                              (skip-chars-forward "\t " p2) (point))))
4066              (if (eq p2 p3)
4067                  (or (eq p2 (setq p3 (- p1 1 folding-internal-margins)))
4068                      (if (> p2 p3)
4069                          (newline (- p2 p3))
4070                        (delete-region p2 p3)))
4071                (delete-region p3 p1)
4072                (newline (1+ folding-internal-margins))))))))
4073
4074 ;;}}}
4075
4076 ;;}}}
4077 ;;{{{ code: Operations on the whole buffer
4078
4079 ;;{{{ folding-whole-buffer
4080
4081 (defun folding-whole-buffer ()
4082   "Folds every fold in the current buffer.
4083 Fails if the fold markers are not balanced correctly.
4084
4085 If the buffer is being viewed in a fold, folds are repeatedly exited to
4086 get to the top level first (this allows the folds to be tidied on the
4087 way out). The buffer modification flag is not affected, and this
4088 function will work on read-only buffers."
4089
4090   (interactive)
4091   (message "Folding buffer...")
4092   (let ((narrow-min (point-min))
4093         (narrow-max (point-max))
4094         folding-list)
4095     (save-excursion
4096       (widen)
4097       (goto-char 1)
4098       (setq folding-list (folding-skip-folds nil t))
4099       (narrow-to-region narrow-min narrow-max)
4100       (and (eq t folding-list)
4101            (error
4102             "Cannot fold whole buffer -- unmatched begin-fold mark `%s' Â´%s'"
4103             (current-buffer)
4104             folding-top-mark))
4105       (and (integerp (car folding-list))
4106            (error
4107             "Cannot fold whole buffer -- extraneous end-fold mark `%s' `%s'"
4108             (current-buffer)
4109             folding-bottom-mark))
4110       (folding-show-all)
4111       (widen)
4112       (goto-char 1)
4113       ;; Do the modifications forwards.
4114       (folding-subst-regions (nreverse (cdr folding-list)) ?\n ?\r))
4115     (beginning-of-line)
4116     (folding-narrow-to-region nil nil t)
4117     (message "Folding buffer... done")))
4118
4119 ;;}}}
4120 ;;{{{ folding-open-buffer
4121
4122 (defun folding-open-buffer ()
4123   "Unfolds the entire buffer, leaving the point where it is.
4124 Does not affect the buffer-modified flag, and can be used on read-only
4125 buffers."
4126   (interactive)
4127   (message "Unfolding buffer...")
4128   (folding-clear-stack)
4129   (folding-set-mode-line)
4130   (unwind-protect
4131       (progn
4132         (widen)
4133         (folding-subst-regions (list 1 (point-max)) ?\r ?\n))
4134     (folding-narrow-to-region nil nil t))
4135   (message "Unfolding buffer... done"))
4136
4137 ;;}}}
4138 ;;{{{ folding-convert-buffer-for-printing
4139
4140 (defun folding-convert-buffer-for-printing (&optional buffer pre-title post-title pad)
4141   "Remove folds from a buffer, for printing.
4142
4143 It copies the contents of the (hopefully) folded buffer BUFFER into a
4144 buffer called `*Unfolded: <Original-name>*', removing all of the fold
4145 marks. It keeps the titles of the folds, however, and numbers them.
4146 Subfolds are numbered in the form 5.1, 5.2, 5.3 etc., and the titles are
4147 indented to eleven characters.
4148
4149 It accepts four arguments. BUFFER is the name of the buffer to be
4150 operated on, or a buffer. nil means use the current buffer. PRE-TITLE
4151 is the text to go before the replacement fold titles, POST-TITLE is the
4152 text to go afterwards. Finally, if PAD is non-nil, the titles are all
4153 indented to the same column, which is eleven plus the length of
4154 PRE-TITLE. Otherwise just one space is placed between the number and
4155 the title."
4156   (interactive (list (read-buffer "Remove folds from buffer: "
4157                                   (buffer-name)
4158                                   t)
4159                      (read-string "String to go before enumerated titles: ")
4160                      (read-string "String to go after enumerated titles: ")
4161                      (y-or-n-p "Pad section numbers with spaces? ")))
4162   (set-buffer (setq buffer (get-buffer buffer)))
4163   (setq pre-title (or pre-title "")
4164         post-title (or post-title ""))
4165   (or folding-mode
4166       (error "Must be in Folding mode before removing folds"))
4167   (let* ((new-buffer (get-buffer-create (concat "*Unfolded: "
4168                                                 (buffer-name buffer)
4169                                                 "*")))
4170          (section-list '(1))
4171          (section-prefix-list '(""))
4172
4173          (secondary-mark-length (length folding-secondary-top-mark))
4174
4175          (secondary-mark folding-secondary-top-mark)
4176          (mode major-mode)
4177
4178          ;;  [jari] Aug 14 1997
4179          ;;  Regexp doesn't allow "footer text" like, so we add one more
4180          ;;  regexp to loosen the end criteria
4181          ;;
4182          ;;  {{{ Subsubsection 1
4183          ;;  }}} Subsubsection 1
4184          ;;
4185          ;;  was:  (regexp folding-regexp)
4186          ;;
4187          (regexp
4188           (concat "\\(^\\|\r\\)\\([ \t]*\\)\\(\\("
4189                   (regexp-quote folding-top-mark)
4190                   "\\)\\|\\("
4191                   (regexp-quote folding-bottom-mark)
4192                   "[ \t]*.*\\(\\)\\($\\|\r\\)\\)\\)"))
4193          title
4194          prefix)
4195     ;;  was obsolete function: (buffer-flush-undo new-buffer)
4196     (buffer-disable-undo new-buffer)
4197     (save-excursion
4198       (set-buffer new-buffer)
4199       (delete-region (point-min)
4200                      (point-max)))
4201     (save-restriction
4202       (widen)
4203       (copy-to-buffer new-buffer (point-min) (point-max)))
4204     (display-buffer new-buffer t)
4205     (set-buffer new-buffer)
4206     (subst-char-in-region (point-min) (point-max) ?\r ?\n)
4207     (funcall mode)
4208     (while (re-search-forward regexp nil t)
4209       (if (match-beginning 4)
4210           (progn
4211             (goto-char (match-end 4))
4212
4213             ;;  - Move after start fold and read the title from there
4214             ;;  - Then move back and kill the fold mark
4215             ;;
4216             (setq title
4217                   (buffer-substring (point)
4218                                     (progn (end-of-line)
4219                                            (point))))
4220             (delete-region (save-excursion
4221                              (goto-char (match-beginning 4))
4222                              (skip-chars-backward "\n\r")
4223                              (point))
4224                            (progn
4225                              (skip-chars-forward "\n\r")
4226                              (point)))
4227             (and (<= secondary-mark-length
4228                      (length title))
4229                  (string-equal secondary-mark
4230                                (substring title
4231                                           (- secondary-mark-length)))
4232                  (setq title (substring title
4233                                         0
4234                                         (- secondary-mark-length))))
4235             (setq section-prefix-list
4236                   (cons (setq prefix (concat (car section-prefix-list)
4237                                              (int-to-string (car section-list))
4238                                              "."))
4239                         section-prefix-list))
4240             (or (cdr section-list)
4241                 (insert ?\n))
4242             (setq section-list (cons 1
4243                                      (cons (1+ (car section-list))
4244                                            (cdr section-list))))
4245             (setq title (concat prefix
4246                                 (if pad
4247                                     (make-string
4248                                      (max 2 (- 8 (length prefix))) ? )
4249                                   " ")
4250                                 title))
4251             (message "Reformatting: %s%s%s"
4252                      pre-title
4253                      title
4254                      post-title)
4255             (insert "\n\n"
4256                     pre-title
4257                     title
4258                     post-title
4259                     "\n\n"))
4260         (goto-char (match-beginning 5))
4261         (or (setq section-list (cdr section-list))
4262             (error "Too many bottom-of-fold marks"))
4263
4264         (setq section-prefix-list (cdr section-prefix-list))
4265         (delete-region (point)
4266                        (progn
4267                          (forward-line 1)
4268                          (point)))))
4269     (and (cdr section-list)
4270          (error
4271           "Too many top-of-fold marks -- reached end of file prematurely"))
4272     (goto-char (point-min))
4273     (buffer-enable-undo)
4274     (set-buffer-modified-p nil)
4275     (message "All folds reformatted.")))
4276
4277 ;;}}}
4278 ;;}}}
4279
4280 ;;{{{ code: Standard fold marks for various major modes
4281
4282 ;;{{{ A function to set default marks, `folding-add-to-marks-list'
4283
4284 (defun folding-add-to-marks-list (mode top bottom
4285                                        &optional secondary noforce message)
4286   "Add/set fold mark list for a particular major mode.
4287 When called interactively, asks for a `major-mode' name, and for
4288 fold marks to be used in that mode. It adds the new set to
4289 `folding-mode-marks-alist', and if the mode name is the same as the current
4290 major mode for the current buffer, the marks in use are also changed.
4291
4292 If called non-interactively, arguments are MODE, TOP, BOTTOM and
4293 SECONDARY. MODE is the symbol for the major mode for which marks are
4294 being set. TOP, BOTTOM and SECONDARY are strings, the three fold marks
4295 to be used. SECONDARY may be nil (as opposed to the empty string), but
4296 the other two must be non-empty strings, and is an optional argument.
4297
4298 Two other optional arguments are NOFORCE, meaning do not change the
4299 marks if marks are already set for the specified mode if non-nil, and
4300 MESSAGE, which causes a message to be displayed if it is non-nil. This
4301 is also the message displayed if the function is called interactively.
4302
4303 To set default fold marks for a particular mode, put something like the
4304 following in your .emacs:
4305
4306 \(folding-add-to-marks-list 'major-mode \"(** {{{ \" \"(** }}} **)\" \" **)\")
4307
4308 Look at the variable `folding-mode-marks-alist' to see what default settings
4309 already apply.
4310
4311 `folding-set-marks' can be used to set the fold marks in use in the current
4312 buffer without affecting the default value for a particular mode."
4313   (interactive
4314    (let* ((mode (completing-read
4315                  (concat "Add fold marks for major mode ("
4316                          (symbol-name major-mode)
4317                          "): ")
4318                  obarray
4319                  (function
4320                   (lambda (arg)
4321                     (and (commandp arg)
4322                          (string-match "-mode\\'"
4323                                        (symbol-name arg)))))
4324                  t))
4325           (mode (if (equal mode "")
4326                     major-mode
4327                   (intern mode)))
4328           (object (assq mode folding-mode-marks-alist))
4329           (old-top (and object
4330                         (nth 1 object)))
4331           top
4332           (old-bottom (and object
4333                            (nth 2 object)))
4334           bottom
4335           (secondary (and object
4336                           (nth 3 object)))
4337           (prompt "Top fold marker: "))
4338      (and (equal secondary "")
4339           (setq secondary nil))
4340      (while (not top)
4341        (setq top (read-string prompt (or old-top "{{{ ")))
4342        (and (equal top "")
4343             (setq top nil)))
4344      (setq prompt (concat prompt
4345                           top
4346                           ", Bottom marker: "))
4347      (while (not bottom)
4348        (setq bottom (read-string prompt (or old-bottom "}}}")))
4349        (and (equal bottom "")
4350             (setq bottom nil)))
4351      (setq prompt (concat prompt
4352                           bottom
4353                           (if secondary
4354                               ", Secondary marker: "
4355                             ", Secondary marker (none): "))
4356            secondary (read-string prompt secondary))
4357      (and (equal secondary "")
4358           (setq secondary nil))
4359      (list mode top bottom secondary nil t)))
4360   (let ((object (assq mode folding-mode-marks-alist)))
4361     (if (and object
4362              noforce
4363              message)
4364         (message "Fold markers for `%s' are already set."
4365                  (symbol-name mode))
4366       (if object
4367           (or noforce
4368               (setcdr object (if secondary
4369                                  (list top bottom secondary)
4370                                (list top bottom))))
4371         (setq folding-mode-marks-alist
4372               (cons (if secondary
4373                         (list mode top bottom secondary)
4374                       (list mode top bottom))
4375                     folding-mode-marks-alist)))
4376       (and message
4377            (message "Set fold marks for `%s' to \"%s\" and \"%s\"."
4378                     (symbol-name mode)
4379                     (if secondary
4380                         (concat top "name" secondary)
4381                       (concat top "name"))
4382                     bottom)
4383            (and (eq major-mode mode)
4384                 (folding-set-marks top bottom secondary))))))
4385
4386 ;;}}}
4387 ;;{{{ Set some useful default fold marks
4388
4389 (folding-add-to-marks-list 'ada-mode               "-- {{{" "-- }}}" nil t)
4390 (folding-add-to-marks-list 'asm-mode               "; {{{"  "; }}}" nil t)
4391 (folding-add-to-marks-list 'awk-mode               "# {{{"  "# }}}" nil t)
4392 (folding-add-to-marks-list 'Bison-mode             "/* {{{" "/* }}} */" " */" t)
4393 (folding-add-to-marks-list 'LaTeX-mode             "%{{{"   "%}}}" nil t)
4394 (folding-add-to-marks-list 'TeX-mode               "%{{{"   "%}}}" nil t)
4395 (folding-add-to-marks-list 'bibtex-mode            "%{{{"   "%}}} */" nil t)
4396 (folding-add-to-marks-list 'bison-mode             "/* {{{" "/* }}} */" " */" t)
4397 (folding-add-to-marks-list 'c++-mode               "// {{{" "// }}}" nil t)
4398 (folding-add-to-marks-list 'c-mode                 "/* {{{" "/* }}} */" " */" t)
4399 (folding-add-to-marks-list 'dcl-mode               "! {{{"  "! }}}" nil t)
4400 (folding-add-to-marks-list 'change-log-mode        "{{{"    "}}}" nil t)
4401 (folding-add-to-marks-list 'cperl-mode             "# {{{"  "# }}}" nil t)
4402 (folding-add-to-marks-list 'emacs-lisp-mode        ";;{{{"  ";;}}}" nil t)
4403 (folding-add-to-marks-list 'erlang-mode            "%%{{{"  "%%}}}" nil t)
4404 (folding-add-to-marks-list 'finder-mode            "{{{"    "}}}" nil t)
4405 (folding-add-to-marks-list 'fortran-mode           "! {{{"  "! }}}" nil t)
4406 (folding-add-to-marks-list 'f90-mode               "! {{{"  "! }}}" nil t)
4407 (folding-add-to-marks-list 'generic-mode           ";# "    ";\$" nil t)
4408 (folding-add-to-marks-list 'gofer-mode             "-- {{{" "-- }}}" nil t)
4409 (folding-add-to-marks-list 'html-mode   "<!-- {{{ " "<!-- }}} -->" " -->" t)
4410 (folding-add-to-marks-list 'icon-mode              "# {{{" "# }}}" nil t)
4411 (folding-add-to-marks-list 'indented-text-mode     "{{{"    "}}}" nil t)
4412 (folding-add-to-marks-list 'java-mode              "// {{{" "// }}}" nil t)
4413 (folding-add-to-marks-list 'javascript-mode        "// {{{" "// }}}" nil t)
4414 (folding-add-to-marks-list 'jde-mode               "// {{{" "// }}}" nil t)
4415 (folding-add-to-marks-list 'ksh-mode               "# {{{"  "# }}}" nil t)
4416 (folding-add-to-marks-list 'latex-mode             "%{{{"   "%}}}" nil t)
4417 (folding-add-to-marks-list 'lisp-interaction-mode  ";;{{{"  ";;}}}" nil t)
4418 (folding-add-to-marks-list 'lisp-mode              ";;{{{"  ";;}}}" nil t)
4419 (folding-add-to-marks-list 'm4-mode                "# {{{" "# }}}" nil t)
4420 (folding-add-to-marks-list 'makefile-mode          "# {{{"  "# }}}" nil t)
4421 (folding-add-to-marks-list 'matlab-mode            "%%%{{{" "%%%}}}" nil t)
4422 (folding-add-to-marks-list 'meta-mode              "% {{{" "% }}}" nil t)
4423 (folding-add-to-marks-list 'ml-mode                "(* {{{" "(* }}} *)" " *)" t)
4424 (folding-add-to-marks-list 'modula-2-mode          "(* {{{" "(* }}} *)" " *)" t)
4425 (folding-add-to-marks-list 'nroff-mode             "\\\\ {{{" "\\\\ }}}" nil t)
4426 (folding-add-to-marks-list 'occam-mode             "-- {{{" "-- }}}" nil t)
4427 (folding-add-to-marks-list 'orwell-mode            "{{{"    "}}}" nil t)
4428 (folding-add-to-marks-list 'pascal-mode            "{ ((( " "{ ))) }" " }" t)
4429 (folding-add-to-marks-list 'php-mode               "// {{{" "// }}}" nil t)
4430 (folding-add-to-marks-list 'perl-mode              "# {{{"  "# }}}" nil t)
4431 (folding-add-to-marks-list 'plain-TeX-mode         "%{{{"   "%}}}" nil t)
4432 (folding-add-to-marks-list 'plain-tex-mode         "%{{{"   "%}}}" nil t)
4433 (folding-add-to-marks-list 'prolog-mode            "% {{{"   "% }}}" nil t)
4434 (folding-add-to-marks-list 'python-mode            "# {{{"  "# }}}" nil t)
4435 (folding-add-to-marks-list 'rexx-mode              "/* {{{" "/* }}} */" " */" t)
4436 (folding-add-to-marks-list 'sh-mode                "# {{{"  "# }}}" nil t)
4437 (folding-add-to-marks-list 'sh-script-mode         "# {{{"  "# }}}" nil t)
4438 (folding-add-to-marks-list 'shellscript-mode       "# {{{"  "# }}}" nil t)
4439 (folding-add-to-marks-list 'sgml-mode   "<!-- [[[ " "<!-- ]]] -->" " -->" t)
4440 (folding-add-to-marks-list 'simula-mode            "! {{{"  "! }}}" nil t)
4441 (folding-add-to-marks-list 'sml-mode               "(* {{{" "(* }}} *)" " *)" t)
4442 (folding-add-to-marks-list 'sql-mode               "-- {{{"  "-- }}}" nil t)
4443 (folding-add-to-marks-list 'tcl-mode               "#{{{"   "#}}}" nil t)
4444 (folding-add-to-marks-list 'tex-mode               "%{{{"   "%}}}" nil t)
4445 (folding-add-to-marks-list 'texinfo-mode   "@c {{{" "@c {{{endfold}}}" " }}}" t)
4446 (folding-add-to-marks-list 'text-mode              "{{{"    "}}}" nil t)
4447 (folding-add-to-marks-list 'vhdl-mode              "# {{{"  "# }}}" nil t)
4448 (folding-add-to-marks-list 'xerl-mode              "%%{{{"  "%%}}}" nil t)
4449 (folding-add-to-marks-list 'xrdb-mode              "! {{{"  "! }}}" nil t)
4450
4451 ;; heavy shell-perl-awk programmer in fundamental-mode need # prefix...
4452
4453 (folding-add-to-marks-list 'fundamental-mode       "# {{{" "# }}}" nil t)
4454
4455 ;;}}}
4456
4457 ;;}}}
4458
4459 ;;{{{ code: Gross, crufty hacks that seem necessary
4460
4461 ;; ----------------------------------------------------------------------
4462 ;; The functions here have been tested with Emacs 18.55, Emacs 18.58,
4463 ;; Epoch 4.0p2 (based on Emacs 18.58) and XEmacs 19.6.
4464
4465 ;; Note that XEmacs 19.6 can't do selective-display, and its
4466 ;; "invisible extents" don't work either, so Folding mode just won't
4467 ;; work with that version.
4468
4469 ;; They shouldn't do the wrong thing with later versions of Emacs, but
4470 ;; they might not have the special effects either. They may appear to
4471 ;; be excessive; that is not the case. All of the peculiar things these
4472 ;; functions do is done to avoid some side-effect of Emacs' internal
4473 ;; logic that I have met. Some of them work around bugs or unfortunate
4474 ;; (lack of) features in Emacs. In most cases, it would be better to
4475 ;; move this into the Emacs C code.
4476
4477 ;; Folding mode is designed to be simple to cooperate with as many
4478 ;; things as possible. These functions go against that principle at the
4479 ;; coding level, but make life for the user bearable.
4480
4481 ;;{{{ folding-subst-regions
4482
4483 ;; Substitute newlines for carriage returns or vice versa.
4484 ;; Avoid excessive file locking.
4485
4486 ;; Substitutes characters in the buffer, even in a read-only buffer.
4487 ;; Takes LIST, a list of regions specified as sequence in the form
4488 ;; (START1 END1 START2 END2 ...). In every region specified by each
4489 ;; pair, substitutes each occurence of character FIND by REPLACE.
4490
4491 ;; The buffer-modified flag is not affected, undo information is not
4492 ;; kept for the change, and the function works on read-only files. This
4493 ;; function is much more efficient called with a long sequence than
4494 ;; called for each region in the sequence.
4495
4496 ;; If the buffer is not modified when the function is called, the
4497 ;; modified-flag is set before performing all the substitutions, and
4498 ;; locking is temporarily disabled. This prevents Emacs from trying to
4499 ;; make then delete a lock file for *every* substitution, which slows
4500 ;; folding considerably, especially on a slow networked filesystem.
4501 ;; Without this, on my system, folding files on startup (and reading
4502 ;; other peoples' folded files) takes about five times longer. Emacs
4503 ;; still locks the file once for this call under those circumstances; I
4504 ;; can't think of a way around that, but it isn't really a problem.
4505
4506 ;; I consider these problems to be a bug in `subst-char-in-region'.
4507
4508 (defun folding-subst-regions (list find replace)
4509   "Substitute \\r and \\n using LIST FIND REPLACE."
4510   (let ((buffer-read-only   buffer-read-only) ;; Protect read-only flag.
4511         (modified           (buffer-modified-p))
4512         (font-lock-mode     nil)
4513         (lazy-lock-mode     nil)
4514         (overlay-p          (folding-use-overlays-p))
4515         (ask1 (symbol-function 'ask-user-about-supersession-threat))
4516         (ask2 (symbol-function 'ask-user-about-lock)))
4517     (if lazy-lock-mode ;; no-op: Byte compiler silencer
4518         (setq lazy-lock-mode t))
4519     (unwind-protect
4520         (progn
4521           (setq buffer-read-only nil)
4522           (or modified
4523               (progn
4524                 (fset 'ask-user-about-supersession-threat
4525                       '(lambda (&rest x) nil))
4526                 (fset 'ask-user-about-lock
4527                       '(lambda (&rest x) nil))
4528                 (set-buffer-modified-p t))) ; Prevent file locking in the loop
4529           (while list
4530             (if overlay-p
4531                 (folding-flag-region (car list) (nth 1 list) (eq find ?\n))
4532               (subst-char-in-region (car list) (nth 1 list) find replace t))
4533             (setq list (cdr (cdr list)))))
4534       ;; buffer-read-only is restored by the let.
4535       ;; Don't want to change MODIFF time if it was modified before.
4536       (or modified
4537           (unwind-protect
4538               (set-buffer-modified-p nil)
4539             (fset 'ask-user-about-supersession-threat ask1)
4540             (fset 'ask-user-about-lock ask2))))))
4541
4542 ;;}}}
4543 ;;{{{ folding-narrow-to-region
4544
4545 ;; Narrow to region, without surprising displays.
4546
4547 ;; Similar to `narrow-to-region', but also adjusts window-start to be
4548 ;; the start of the narrowed region. If an optional argument CENTRE is
4549 ;; non-nil, the window-start is positioned to leave the point at the
4550 ;; centre of the window, like `recenter'. START may be nil, in which
4551 ;; case the function acts more like `widen'.
4552
4553 ;; Actually, all the window-starts for every window displaying the
4554 ;; buffer, as well as the last_window_start for the buffer are set. The
4555 ;; points in every window are set to the point in the current buffer.
4556 ;; All this logic is necessary to prevent the display getting really
4557 ;; weird occasionally, even if there is only one window. Try making
4558 ;; this function like normal `narrow-to-region' with a touch of
4559 ;; `recenter', then moving around lots of folds in a buffer displayed in
4560 ;; several windows. You'll see what I mean.
4561
4562 ;; last_window_start is set by making sure that the selected window is
4563 ;; displaying the current buffer, then setting the window-start, then
4564 ;; making the selected window display another buffer (which sets
4565 ;; last_window_start), then setting the selected window to redisplay the
4566 ;; buffer it displayed originally.
4567
4568 ;; Note that whenever window-start is set, the point cannot be moved
4569 ;; outside the displayed area until after a proper redisplay. If this
4570 ;; is possible, centre the display on the point.
4571
4572 ;; In Emacs 19; Epoch or XEmacs, searches all screens for all
4573 ;; windows. In Emacs 19, they are called "frames".
4574
4575 (defun folding-narrow-to-region (&optional start end centre)
4576   "Narrow to region START END, possibly CENTRE."
4577   (let* ((the-window        (selected-window))
4578          (selected-buffer   (window-buffer the-window))
4579          (window-ring       the-window)
4580          (window            the-window)
4581          (point             (point))
4582          (buffer            (current-buffer))
4583          temp)
4584     (unwind-protect
4585         (progn
4586           (unwind-protect
4587               (progn
4588                 (if (folding-use-overlays-p)
4589                     (if start
4590                         (folding-narrow-aux  start end t)
4591                       (folding-narrow-aux  nil nil nil))
4592                   (if start
4593                       (narrow-to-region start end)
4594                     (widen)))
4595
4596                 (setq point (point))
4597                 (set-window-buffer window buffer)
4598
4599                 (while (progn
4600                          (and (eq buffer (window-buffer window))
4601                               (if centre
4602                                   (progn
4603                                     (select-window window)
4604                                     (goto-char point)
4605                                     (vertical-motion
4606                                      (- (lsh (window-height window) -1)))
4607                                     (set-window-start window (point))
4608                                     (set-window-point window point))
4609                                 (set-window-start window (or start 1))
4610                                 (set-window-point window point)))
4611
4612                          (not (eq (setq window (next-window window nil t))
4613                                   window-ring)))))
4614             nil                         ;; epoch screen
4615             (select-window the-window)) ;; unwind-protect INNER
4616           ;; Set last_window_start.
4617           (unwind-protect
4618               (if (not (eq buffer selected-buffer))
4619                   (set-window-buffer the-window selected-buffer)
4620                 (if (get-buffer "*scratch*")
4621                     (set-window-buffer the-window (get-buffer "*scratch*"))
4622                   (set-window-buffer
4623                    the-window (setq temp (generate-new-buffer " *temp*"))))
4624                 (set-window-buffer the-window buffer))
4625             (and temp
4626                  (kill-buffer temp))))
4627       ;; Undo this side-effect of set-window-buffer.
4628       (set-buffer buffer)
4629       (goto-char (point)))))
4630
4631 ;;}}}
4632
4633 ;;}}}
4634
4635 ;;{{{ code: folding-end-mode-quickly
4636
4637 (defun folding-end-mode-quickly ()
4638   "Replace all ^M's with linefeeds and widen a folded buffer.
4639 Only has any effect if Folding mode is active.
4640
4641 This should not in general be used for anything. It is used when changing
4642 major modes, by being placed in kill-mode-tidy-alist, to tidy the buffer
4643 slightly. It is similar to `(folding-mode 0)', except that it does not
4644 restore saved keymaps etc. Repeat: Do not use this function. Its
4645 behaviour is liable to change."
4646   (and (boundp 'folding-mode)
4647        (assq 'folding-mode
4648              (buffer-local-variables))
4649        folding-mode
4650        (progn
4651          (if (folding-use-overlays-p)
4652              (folding-narrow-to-region nil nil)
4653            (widen))
4654          (folding-clear-stack)
4655          (folding-subst-regions (list 1 (point-max)) ?\r ?\n))))
4656
4657 ;;{{{ folding-eval-current-buffer-open-folds
4658
4659 (defun folding-eval-current-buffer-open-folds (&optional printflag)
4660   "Evaluate all of a folded buffer as Lisp code.
4661 Unlike `eval-current-buffer', this function will evaluate all of a
4662 buffer, even if it is folded. It will also work correctly on non-folded
4663 buffers, so is a good candidate for being bound to a key if you program
4664 in Emacs-Lisp.
4665
4666 It works by making a copy of the current buffer in another buffer,
4667 unfolding it and evaluating it. It then deletes the copy.
4668
4669 Programs can pass argument PRINTFLAG which controls printing of output:
4670 nil means discard it; anything else is stream for print."
4671   (interactive)
4672   (if (or (and (boundp 'folding-mode)
4673                folding-mode))
4674       (let ((temp-buffer
4675              (generate-new-buffer (buffer-name))))
4676         (message "Evaluating unfolded buffer...")
4677         (save-restriction
4678           (widen)
4679           (copy-to-buffer temp-buffer 1 (point-max)))
4680         (set-buffer temp-buffer)
4681         (subst-char-in-region 1 (point-max) ?\r ?\n)
4682         (let ((real-message-def (symbol-function 'message))
4683               (suppress-eval-message))
4684           (fset 'message
4685                 (function
4686                  (lambda (&rest args)
4687                    (setq suppress-eval-message t)
4688                    (fset 'message real-message-def)
4689                    (apply 'message args))))
4690           (unwind-protect
4691               (eval-current-buffer printflag)
4692             (fset 'message real-message-def)
4693             (kill-buffer temp-buffer))
4694           (or suppress-eval-message
4695               (message "Evaluating unfolded buffer... Done"))))
4696     (eval-current-buffer printflag)))
4697
4698 ;;}}}
4699
4700 ;;}}}
4701
4702 ;;{{{ code: ISearch support, walks in and out of folds
4703
4704 ;; This used to be a package of it's own.
4705 ;; Requires Emacs 19 or XEmacs. Does not work under Emacs 18.
4706
4707 ;;{{{ Variables
4708
4709 (defcustom folding-isearch-install t
4710   "*When non-nil, the isearch commands will handle folds."
4711   :type 'boolean
4712   :group 'folding)
4713
4714 (defvar folding-isearch-stack nil
4715   "Temporary storage for `folding-stack' during isearch.")
4716
4717 ;; Lists of isearch commands to replace
4718
4719 ;; These do normal searching.
4720
4721 (defvar folding-isearch-normal-cmds
4722   '(isearch-repeat-forward
4723     isearch-repeat-backward
4724     isearch-toggle-regexp
4725     isearch-toggle-case-fold
4726     isearch-delete-char
4727     isearch-abort
4728     isearch-quote-char
4729     isearch-other-control-char
4730     isearch-other-meta-char
4731     isearch-return-char
4732     isearch-exit
4733     isearch-printing-char
4734     isearch-whitespace-chars
4735     isearch-yank-word
4736     isearch-yank-line
4737     isearch-yank-kill
4738     isearch-*-char
4739     isearch-\|-char
4740     isearch-mode-help
4741     isearch-yank-x-selection
4742     isearch-yank-x-clipboard)
4743   "List if isearch commands doing normal search.")
4744
4745 ;; Enables the user to edit the search string
4746
4747 ;; Missing, present in XEmacs isearch-mode.el. Not necessary?
4748 ;; isearch-ring-advance-edit, isearch-ring-retreat-edit, isearch-complete-edit
4749 ;; isearch-nonincremental-exit-minibuffer, isearch-yank-x-selection,
4750 ;; isearch-yank-x-clipboard
4751
4752 (defvar folding-isearch-edit-enter-cmds
4753   '(isearch-edit-string
4754     isearch-ring-advance
4755     isearch-ring-retreat
4756     isearch-complete)              ; (Could also stay in search mode!)
4757   "List of isearch commands which enters search string edit.")
4758
4759 ;; Continues searching after editing.
4760
4761 (defvar folding-isearch-edit-exit-cmds
4762   '(isearch-forward-exit-minibuffer     ; Exits edit
4763     isearch-reverse-exit-minibuffer
4764     isearch-nonincremental-exit-minibuffer)
4765   "List of isearch commands which exits search string edit.")
4766
4767 ;;}}}
4768 ;;{{{ Keymaps (an Isearch hook)
4769
4770 (defvar folding-isearch-mode-map nil
4771   "Modified copy of the isearch keymap.")
4772
4773 ;; Create local copies of the keymaps. The `isearch-mode-map' is
4774 ;; copied to `folding-isearch-mode-map' while `minibuffer-local-isearch-map'
4775 ;; is made local. (Its name is used explicitly.)
4776 ;;
4777 ;; Note: This is called every time the search is started.
4778
4779 (defun folding-isearch-hook-function ()
4780   "Update the isearch keymaps for usage with folding mode."
4781   (if (and (boundp 'folding-mode) folding-mode)
4782       (let ((cmds (append folding-isearch-normal-cmds
4783                           folding-isearch-edit-enter-cmds
4784                           folding-isearch-edit-exit-cmds)))
4785         (setq folding-isearch-mode-map (copy-keymap isearch-mode-map))
4786         (make-local-variable 'minibuffer-local-isearch-map)
4787         ;; Make sure the destructive operations below doesn't alter
4788         ;; the global instance of the map.
4789         (setq minibuffer-local-isearch-map
4790               (copy-keymap minibuffer-local-isearch-map))
4791         (setq folding-isearch-stack folding-stack)
4792         (while cmds
4793           (substitute-key-definition
4794            (car cmds)
4795            (intern (concat "folding-" (symbol-name (car cmds))))
4796            folding-isearch-mode-map)
4797           (substitute-key-definition
4798            (car cmds)
4799            (intern (concat "folding-" (symbol-name (car cmds))))
4800            minibuffer-local-isearch-map)
4801           (setq cmds (cdr cmds)))
4802         ;; Install our keymap
4803         (cond
4804          (folding-xemacs-p
4805           (let ((f 'set-keymap-name))
4806             (funcall f folding-isearch-mode-map 'folding-isearch-mode-map))
4807           ;; Later version of XEmacs (21.2+) use overriding-local-map
4808           ;; for isearch keymap rather than fiddling with
4809           ;; minor-mode-map-alist.  This is so isearch keymaps take
4810           ;; precedence over extent-local keymaps.  We will support
4811           ;; both ways here.  Keymaps will be restored as side-effect
4812           ;; of isearch-abort and isearch-quit
4813           (cond
4814            ;; if overriding-local-map is in use
4815            ((and (boundp 'overriding-local-map) overriding-local-map)
4816             (set-keymap-parent folding-isearch-mode-map overriding-local-map)
4817             (setq overriding-local-map folding-isearch-mode-map))
4818            ;; otherwise fiddle with minor-mode-map-alist
4819            (t
4820             (setq minor-mode-map-alist
4821                   (cons (cons 'isearch-mode folding-isearch-mode-map)
4822                         (delq (assoc 'isearch-mode minor-mode-map-alist)
4823                               minor-mode-map-alist))))))
4824          ((boundp 'overriding-terminal-local-map)
4825           (funcall (symbol-function 'set)
4826                    'overriding-terminal-local-map folding-isearch-mode-map))
4827          ((boundp 'overriding-local-map)
4828           (setq overriding-local-map folding-isearch-mode-map))))))
4829
4830 ;; Undoes the `folding-isearch-hook-function' function.
4831
4832 (defun folding-isearch-end-hook-function ()
4833   "Actions to perform at the end of isearch in folding mode."
4834   (when (and (boundp 'folding-mode) folding-mode)
4835     (kill-local-variable 'minibuffer-local-isearch-map)
4836     (setq folding-stack folding-isearch-stack)))
4837
4838 (when folding-isearch-install
4839   (add-hook 'isearch-mode-hook 'folding-isearch-hook-function)
4840   (add-hook 'isearch-mode-end-hook 'folding-isearch-end-hook-function))
4841
4842 ;;}}}
4843 ;;{{{ Normal search routines
4844
4845 ;; Generate the replacement functions of the form:
4846 ;;    (defun folding-isearch-repeat-forward ()
4847 ;;      (interactive)
4848 ;;      (folding-isearch-general 'isearch-repeat-forward))
4849
4850 (let ((cmds folding-isearch-normal-cmds))
4851   (while cmds
4852     (eval
4853      `(defun ,(intern (concat "folding-" (symbol-name (car cmds))))
4854         nil
4855         "Automatically generated"
4856         (interactive)
4857         (folding-isearch-general (quote ,(car cmds)))))
4858     (setq cmds (cdr cmds))))
4859
4860 ;; The HEART! Executes command and updates the foldings.
4861 ;; This is capable of detecting a `quit'.
4862
4863 (defun folding-isearch-general (function)
4864   "Execute isearch command FUNCTION and adjusts the folding."
4865   (let* ((quit-isearch  nil)
4866          (area-beg      (point-min))
4867          (area-end      (point-max))
4868          pos)
4869     (cond
4870      (t
4871       (save-restriction
4872         (widen)
4873         (condition-case nil
4874             (funcall function)
4875           (quit  (setq quit-isearch t)))
4876         (setq pos (point)))
4877       ;; Situation
4878       ;; o   user has folded buffer
4879       ;; o   He manually narrows, say to function !
4880       ;; --> there is no fold marks at the beg/end --> this is not a fold
4881       (condition-case nil
4882           ;; "current mode has no fold marks..."
4883           (folding-region-has-folding-marks-p area-beg area-end)
4884         (error (setq quit-isearch t)))
4885       (folding-goto-char pos)))
4886     (if quit-isearch
4887         (signal 'quit '(isearch)))))
4888
4889 ;;}}}
4890 ;;{{{ Edit search string support
4891
4892 (defvar folding-isearch-current-buffer nil
4893   "The buffer we are editing, so we can widen it when in minibuffer.")
4894
4895 ;; Functions which enters edit mode.
4896
4897 (defun folding-isearch-edit-string ()
4898   "Replace `isearch-edit-string' when in `folding-mode'."
4899   (interactive)
4900   (folding-isearch-start-edit 'isearch-edit-string))
4901
4902 (defun folding-isearch-ring-advance ()
4903   "Replace `isearch-ring-advance' when in `folding-mode'."
4904   (interactive)
4905   (folding-isearch-start-edit 'isearch-ring-advance))
4906
4907 (defun folding-isearch-ring-retreat ()
4908   "Replace `isearch-ring-retreat' when in `folding-mode'."
4909   (interactive)
4910   (folding-isearch-start-edit 'isearch-ring-retreat))
4911
4912 (defun folding-isearch-complete ()
4913   "Replace `isearch-complete' when in `folding-mode'."
4914   (interactive)
4915   (folding-isearch-start-edit 'isearch-complete))
4916
4917 ;; Start and wait for editing. When (funcall fnk) returns
4918 ;; we are back in interactive search mode.
4919 ;;
4920 ;; Store match data!
4921
4922 (defun folding-isearch-start-edit (function)
4923   "Edit with function FUNCTION."
4924   (let (pos)
4925     (setq folding-isearch-current-buffer (current-buffer))
4926     (save-restriction
4927       (funcall function)
4928       ;; Here, we are widened, by folding-isearch-*-exit-minibuffer.
4929       (setq pos (point)))
4930     (folding-goto-char pos)))
4931
4932 ;; Functions which exits edit mode.
4933
4934 ;; The `widen' below will be caught by the `save-restriction' above, thus
4935 ;; this will not cripple `folding-stack'.
4936
4937 (defun folding-isearch-forward-exit-minibuffer ()
4938   "Replace `isearch-forward-exit-minibuffer' when in `folding-mode'."
4939   (interactive)
4940   ;; Make sure we can continue searching outside narrowing.
4941   (save-excursion
4942     (set-buffer folding-isearch-current-buffer)
4943     (widen))
4944   (isearch-forward-exit-minibuffer))
4945
4946 (defun folding-isearch-reverse-exit-minibuffer ()
4947   "Replace `isearch-reverse-exit-minibuffer' when in `folding-mode'."
4948   (interactive)
4949   ;; Make sure we can continue searching outside narrowing.
4950   (save-excursion
4951     (set-buffer folding-isearch-current-buffer)
4952     (widen))
4953   (isearch-reverse-exit-minibuffer))
4954
4955 (defun folding-isearch-nonincremental-exit-minibuffer ()
4956   "Replace `isearch-reverse-exit-minibuffer' when in `folding-mode'."
4957   (interactive)
4958   ;; Make sure we can continue searching outside narrowing.
4959   (save-excursion
4960     (set-buffer folding-isearch-current-buffer)
4961     (widen))
4962   (isearch-nonincremental-exit-minibuffer))
4963
4964 ;;}}}
4965 ;;{{{ Special XEmacs support
4966
4967 ;; In XEmacs, all isearch commands must have the property `isearch-command'.
4968
4969 (if folding-xemacs-p
4970     (let ((cmds (append folding-isearch-normal-cmds
4971                         folding-isearch-edit-enter-cmds
4972                         folding-isearch-edit-exit-cmds)))
4973       (while cmds
4974         (put (intern (concat "folding-" (symbol-name (car cmds))))
4975              'isearch-command t)
4976         (setq cmds (cdr cmds)))))
4977
4978 ;;}}}
4979 ;;{{{ General purpose function.
4980
4981 (defun folding-goto-char (pos)
4982   "Goto character POS, changing fold if necessary."
4983   ;; Make sure POS is inside the visible area of the buffer.
4984   (goto-char pos)
4985   (if (eq pos (point))                  ; Point inside narrowed area?
4986       nil
4987     (folding-show-all)                 ; Fold everything and goto top.
4988     (goto-char pos))
4989   ;; Enter if point is folded.
4990   (if (folding-point-folded-p pos)
4991       (progn
4992         (folding-shift-in)      ; folding-shift-in can change the pos.
4993         (setq folding-isearch-stack folding-stack)
4994         (setq folding-stack '(folded))
4995         (goto-char pos))))
4996
4997 (defun folding-point-folded-p (pos)
4998   "Non-nil when POS is not visible."
4999   (if (folding-use-overlays-p)
5000       (let ((overlays (overlays-at (point)))
5001             (found nil))
5002         (while (and (not found) (overlayp (car overlays)))
5003           (setq found (overlay-get (car overlays) 'fold)
5004                 overlays (cdr overlays)))
5005         found)
5006     (save-excursion
5007       (goto-char pos)
5008       (beginning-of-line)
5009       (skip-chars-forward "^\r" pos)
5010       (not (eq pos (point))))))
5011
5012 ;;}}}
5013
5014 ;;}}}
5015 ;;{{{ code: Additional functions
5016
5017 (defvar folding-comment-folding-table
5018   '((c-mode
5019      folding-comment-c-mode
5020      folding-uncomment-c-mode))
5021   "Table of functions to comment and uncomment folds.
5022 Function is called with two arguments:
5023
5024   number    start of fold mark
5025   marker    end of fold mark
5026
5027 Function must return:
5028
5029   (beg . end)    start of fold, end of fold
5030
5031 Table Format:
5032  '((MAJOR-MODE COMMENT-FUNCTION UNCOMMENT-FUNCTION) ..)")
5033
5034 (defun folding-insert-advertise-folding-mode ()
5035   "Insert Small text describing where to the get the folding at point.
5036 This may be useful 'banner' to inform other people why your code
5037 is formatted like it is and how to view it correctly."
5038   (interactive)
5039   (let* ((prefix "")
5040          (re    (or comment-start-skip
5041                     (and comment-start
5042                          (concat "^[ \t]*" comment-start "+[ \t]*")))))
5043
5044     (when re
5045       (save-excursion
5046         (beginning-of-line)
5047         (when (or (re-search-forward re nil t)
5048                   (progn
5049                     (goto-char (point-min))
5050                     (re-search-forward re nil t)))
5051           (setq prefix (match-string 0)))))
5052
5053     (beginning-of-line)
5054     (dolist (line
5055              (list
5056               "File layout controlled by Emacs folding.el available at: "
5057               folding-package-url-location))
5058       (insert "\n" prefix line))))
5059
5060 (defun folding-uncomment-mode-generic (beg end tag)
5061   "In region (BEG . END) remove two TAG lines."
5062   (re-search-forward tag (marker-position end))
5063   (beginning-of-line)
5064   (kill-line 1)
5065   (re-search-forward tag (marker-position end))
5066   (beginning-of-line)
5067   (kill-line 1)
5068   (cons beg end))
5069
5070 (defun folding-comment-mode-generic (beg end tag1 &optional tag2)
5071   "Return (BEG . END) and Add two TAG1 and TAG2 lines."
5072   (insert tag1)
5073   (goto-char (marker-position end))
5074   (insert (or tag2 tag1))
5075   (cons beg end))
5076
5077 (defun folding-uncomment-c-mode  (beg end)
5078   "Uncomment region BEG END."
5079   (folding-uncomment-mode-generic
5080    beg end (regexp-quote " comment /* FOLDING -COM- */")))
5081
5082 (defun folding-comment-c-mode  (beg end)
5083   "Comment region BEG END."
5084   (let* ((tag " /* FOLDING -COM- */"))
5085     (folding-comment-mode-generic
5086      beg end
5087      (concat "#if comment"    tag "\n")
5088      (concat "#endif comment" tag "\n"))))
5089
5090 (defun folding-comment-fold  (&optional uncomment)
5091   "Comment or UNCOMMENT all text inside single fold.
5092 If there are subfolds this function won't work as expected.
5093 User must know that there are no subfolds.
5094
5095 The heading has -COM- at the end when the fold is commented.
5096 Point must be over fold heading {{{ when function is called.
5097
5098 Note:
5099
5100  You can use this function only in modes that do _not_ have
5101  `comment-end'. Ie. don't use this function in modes like C (/* */), because
5102  nested comments are not allowed. See this:
5103
5104     /* {{{ fold */
5105        code  /* comment of the code */
5106     /* }}} */
5107
5108  Fold can't know how to comment the `code' inside fold, because comments
5109  do not nest.
5110
5111 Implementation detail:
5112
5113  {{{ FoldHeader-COM-
5114
5115  If the fold header has -COM- at the end, then the fold is supposed to
5116  be commented. And if there is no -COM- then fold will be considered
5117  as normal fold. Do not loose or add the -COM- yourself or it will
5118  confuse the state of the fold.
5119
5120 References:
5121
5122  `folding-comment-folding-table'"
5123   (interactive "P")
5124   (let* ((state     (folding-mark-look-at 'move))
5125          (closed    (eq 0 state))
5126          (id        "-COM-")
5127          (opoint    (point))
5128          (mode-elt  (assq major-mode folding-comment-folding-table))
5129          comment
5130          ret
5131          beg
5132          end)
5133     (unless mode-elt
5134       (if (stringp (nth 2 (folding-get-mode-marks major-mode)))
5135           (error "\
5136 Folding: function usage error, mode with `comment-end' is not supported.")))
5137     (when (or (null comment-start)
5138               (not (string-match "[^ \t\n]" comment-start)))
5139       (error "Empty comment-start."))
5140     (unless (memq state '( 0 1 11))
5141       (error "Incorrect fold state. Point must be over {{{."))
5142     ;;  There is nothing to do if this fold heading does not have
5143     ;;  the ID when uncommenting the fold.
5144     (setq state (looking-at (concat ".*" id)))
5145     (when (or (and uncomment state)
5146               (and (null uncomment) (null state)))
5147       (when closed (save-excursion (folding-show-current-entry)))
5148       (folding-pick-move)               ;Go to end
5149       (beginning-of-line)
5150       (setq end (point-marker))
5151       (goto-char opoint)                ;And off the fold heading
5152       (forward-line 1)
5153       (setq beg (point))
5154       (setq comment (concat comment-start id))
5155       (cond
5156        (mode-elt
5157         (setq ret
5158               (if uncomment
5159                   (funcall (nth 2 mode-elt) (point) end)
5160                 (funcall (nth 1 mode-elt) (point) end)))
5161         (goto-char (cdr ret)))
5162        (uncomment
5163         (while (< (point) (marker-position end))
5164           (if (looking-at comment)
5165               (delete-region (point) (match-end 0)))
5166           (forward-line 1)))
5167        (t
5168         (while (< (point) (marker-position end))
5169           (if (not (looking-at comment))
5170               (insert comment))
5171           (forward-line 1))))
5172       (setq end nil)                    ;kill marker
5173       ;;  Remove the possible tag from the fold name line
5174       (goto-char opoint)
5175       (setq id (concat (or comment-start "") id (or comment-end "")))
5176       (if (re-search-forward (regexp-quote id) beg t)
5177           (delete-region (match-beginning 0)  (match-end 0)))
5178       (when (null uncomment)
5179         (end-of-line)
5180         (insert id))
5181       (if closed
5182           (folding-hide-current-entry))
5183       (goto-char opoint))))
5184
5185 (defun folding-convert-to-major-folds ()
5186   "Convert fold mark items according to `major-mode'.
5187 This function replaces all fold markings }}} and {{{
5188 with major mode's fold marks.
5189
5190 As a side effect also corrects all foldings to standard notation.
5191 Eg. following, where correct folding-beg should be \"#{{{ \"
5192 Note that /// marks foldings.
5193
5194   ///                  ;wrong fold
5195   #     ///           ;too many spaces, fold format error
5196   # ///title            ;ok, but title too close
5197
5198   produces
5199
5200   #///
5201   #///
5202   #/// title
5203
5204 You must 'unfold' whole buffer before using this function."
5205   (interactive)
5206   (let (case-fold-search
5207         (bm "{{{")                      ; begin match mark
5208         (em "}}}")                      ;
5209         el                              ; element
5210         b                               ; begin
5211         e                               ; end
5212         e2                              ; end2
5213         pp)
5214     (catch 'out                         ; is folding active/loaded ??
5215       (unless (setq el (folding-get-mode-marks major-mode))
5216         (throw 'out t))                 ; ** no mode found
5217       ;; ok , we're in business. Search whole buffer and replace.
5218       (setq b  (elt el 0)
5219             e  (elt el 1)
5220             e2 (or (elt el 2) ""))
5221       (save-excursion
5222         (goto-char (point-min))   ; start from the beginning of buffer
5223         (while (re-search-forward (regexp-quote bm) nil t)
5224           ;; set the end position for fold marker
5225           (setq pp (point))
5226           (beginning-of-line)
5227           (if (looking-at (regexp-quote b)) ; should be mode-marked; ok, ignore
5228               (goto-char pp)       ; note that beg-of-l cmd, move rexp
5229             (delete-region (point) pp)
5230             (insert b)
5231             (when (not (string= "" e2))
5232               (unless (looking-at (concat ".*" (regexp-quote e2)))
5233                 ;; replace with right fold mark
5234                 (end-of-line)
5235                 (insert e2)))))
5236         ;; handle end marks , identical func compared to prev.
5237         (goto-char (point-min))
5238         (while (re-search-forward (regexp-quote em)nil t)
5239           (setq pp (point))
5240           (beginning-of-line)
5241           (if (looking-at (regexp-quote e))
5242               (goto-char pp)
5243             (delete-region (point) (progn (end-of-line) (point)))
5244             (insert e)))))))
5245
5246 (defun folding-all-comment-blocks-in-region (beg end)
5247   "Put all comments in folds inside BEG END.
5248 Notice: Make sure there is no interfering folds inside the area,
5249 because the results may and up corrupted.
5250
5251 This only works for modes that DO NOT have `comment-end'.
5252 The `comment-start' must be left flushed in order to counted in.
5253
5254 After this
5255
5256     ;; comment
5257     ;; comment
5258
5259     code
5260
5261     ;; comment
5262     ;; comment
5263
5264     code
5265
5266 The result will be:
5267
5268     ;; {{{ 1
5269
5270     ;; comment
5271     ;; comment
5272
5273     ;; }}}
5274
5275     code
5276
5277     ;; {{{ 2
5278
5279     ;; comment
5280     ;; comment
5281
5282     ;; }}}
5283
5284     code"
5285   (interactive "*r")
5286
5287   (unless comment-start
5288     (error "Folding: Mode does not define `comment-start'"))
5289
5290   (when (and (stringp comment-end)
5291              (string-match "[^ \t]" comment-end))
5292     (error "Folding: Mode defines non-empty `comment-end'."))
5293   (let* ((count          0)
5294          (comment-regexp (concat "^" comment-start))
5295          (marker         (point-marker))
5296          done)
5297     (destructuring-bind (left right ignore)
5298         (folding-get-mode-marks)
5299       ;; Bytecomp silencer: variable ignore bound but not referenced
5300       (if ignore (setq ignore ignore))
5301       ;; %%%{{{  --> "%%%"
5302       (string-match (concat (regexp-quote comment-start) "+") left)
5303       (save-excursion
5304         (goto-char beg)
5305         (beginning-of-line)
5306         (while (re-search-forward comment-regexp nil t)
5307           (move-marker marker (point))
5308           (setq done nil)
5309           (beginning-of-line)
5310           (forward-line -1)
5311           ;; 2 previous lines Must not contain FOLD beginning already
5312           (unless (looking-at (regexp-quote left))
5313             (forward-line -1)
5314             (unless (looking-at (regexp-quote left))
5315               (goto-char (marker-position marker))
5316               (beginning-of-line)
5317               (insert  left " " (int-to-string count) "\n\n")
5318               (incf count)
5319               (setq done t)))
5320           (goto-char (marker-position marker))
5321           (when done
5322             ;; Try finding pat of the comment block
5323             (if (not (re-search-forward "^[ \t]*$" nil t))
5324                 (goto-char end))
5325             (open-line 1)
5326             (forward-line 1)
5327             (insert right "\n")))))))
5328
5329 ;;}}}
5330 ;;{{{ code: Overlay support
5331
5332 (defun folding-use-overlays-p ()
5333   "Should folding use overlays?."
5334   (if folding-allow-overlays
5335       (if folding-xemacs-p
5336           ;;  See if we can load overlay.el library that comes in 19.15
5337           ;;  This call returns t or nil if load was successful
5338           ;;  Note: is there provide statement? Load is so radical
5339           ;;
5340           (load "overlay" 'noerr)
5341         t)))
5342
5343 (defun folding-flag-region (from to flag)
5344   "Hide or show lines from FROM to TO, according to FLAG.
5345 If FLAG is nil then text is shown, while if FLAG is t the text is hidden."
5346   (let ((inhibit-read-only t)
5347         overlay)
5348     (save-excursion
5349       (goto-char from)
5350       (end-of-line)
5351       (cond
5352        (flag
5353         (setq overlay (make-overlay (point) to))
5354         (folding-make-overlay-hidden overlay))
5355        (t
5356         (if (fboundp 'hs-discard-overlays)
5357             (funcall (symbol-function 'hs-discard-overlays)
5358                      (point) to 'invisible t)))))))
5359
5360 (defun folding-make-overlay-hidden (overlay)
5361   "Make OVERLAY hidden."
5362   (overlay-put overlay  'fold t)
5363   ;;  (overlay-put overlay 'intangible t)
5364   (overlay-put overlay 'invisible t)
5365   (overlay-put overlay 'owner 'folding))
5366
5367 (defun folding-narrow-aux (start end arg)
5368   "Narrow. Make overlay from `point-min' to START.
5369 And from END t `point-min'. If ARG is nil, delete overlays."
5370   (if (null arg)
5371       (cond
5372        (folding-narrow-overlays
5373         (delete-overlay (car folding-narrow-overlays))
5374         (delete-overlay (cdr folding-narrow-overlays))
5375         (setq folding-narrow-overlays nil)))
5376     (let ((overlay-beg (make-overlay (point-min) start))
5377           (overlay-end (make-overlay  end (point-max))))
5378       (overlay-put overlay-beg 'folding-narrow t)
5379       (overlay-put overlay-beg 'invisible t)
5380       (overlay-put overlay-beg 'owner 'folding)
5381       (overlay-put overlay-end 'folding-narrow t)
5382       (overlay-put overlay-end 'invisible t)
5383       (overlay-put overlay-end 'owner 'folding)
5384       (setq folding-narrow-overlays (cons overlay-beg  overlay-end)))))
5385
5386 ;;}}}
5387 ;;{{{ code: end of file tag, provide
5388
5389 (folding-install)
5390
5391 (provide 'folding)
5392 (provide 'folding-isearch) ;; This used to be a separate package.
5393
5394 (run-hooks 'folding-load-hook)
5395
5396 ;;}}}
5397
5398 ;;; folding.el ends here