summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGravatar Tom Willemsen2011-04-16 23:03:44 +0200
committerGravatar Tom Willemsen2011-04-16 23:03:44 +0200
commitd1502aa2456b2dd5747eb6105ba671e9a1a3134a (patch)
tree959cb2364a75070932e0991d0e977c4e1d24bec1
parent0be324a314c0c5c0fdd7a35ed146bafe7d0850d7 (diff)
downloaddotfiles-d1502aa2456b2dd5747eb6105ba671e9a1a3134a.tar.gz
dotfiles-d1502aa2456b2dd5747eb6105ba671e9a1a3134a.zip
Folding is out
-rw-r--r--emacs.d/20-folding.el10
-rw-r--r--emacs.d/elisp/folding.el5416
2 files changed, 0 insertions, 5426 deletions
diff --git a/emacs.d/20-folding.el b/emacs.d/20-folding.el
deleted file mode 100644
index fcf7cc4..0000000
--- a/emacs.d/20-folding.el
+++ /dev/null
@@ -1,10 +0,0 @@
-(if (load "folding")
- (progn (add-hook 'folding-mode-hook
- (lambda ()
- (local-set-key [C-tab] 'folding-toggle-show-hide)))
- (add-hook 'c-mode-hook
- (lambda ()
- (folding-mode)))
- (add-hook 'emacs-lisp-mode-hook
- (lambda ()
- (folding-mode)))))
diff --git a/emacs.d/elisp/folding.el b/emacs.d/elisp/folding.el
deleted file mode 100644
index 17cea28..0000000
--- a/emacs.d/elisp/folding.el
+++ /dev/null
@@ -1,5416 +0,0 @@
-;;; folding.el --- A folding-editor-like minor mode.
-
-;; This file is not part of Emacs
-
-;; Copyright (C) 2000-2010
-;; Jari Aalto
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999
-;; Jari Aalto, Anders Lindgren.
-;; Copyright (C) 1994
-;; Jari Aalto
-;; Copyright (C) 1992, 1993
-;; Jamie Lokier, All rights reserved.
-;;
-;; Author: Jamie Lokier <jamie A T imbolc.ucc dt ie>
-;; Jari Aalto <jari aalto A T cante dt net>
-;; Anders Lindgren <andersl A T csd.uu dt se>
-;; Maintainer: Jari Aalto <jari aalto A T cante dt net>
-;; Created: 1992
-;; Keywords: tools
-;;
-;; [Latest XEmacs CVS tree commit and revision]
-;; Vcs-Version: $Revision: 3.42 $
-;; Vcs-Date: $Date: 2007/05/07 10:50:05 $
-;;
-;; [Latest devel version]
-;; Vcs-URL: http://savannah.nongnu.org/projects/emacs-tiny-tools
-
-(defconst folding-version-time "2010.0428.2238"
- "Last edit time in format YYYY.MMDD.HHMM.")
-
-;;{{{ GPL
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation,
-;; or (at your option) any later version.
-;;
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-;;
-;; Visit <http://www.gnu.org/copyleft/gpl.html> for more information
-
-;;}}}
-
-;;; Commentary:
-
-;;{{{ Introduction
-
-;; Preface
-;;
-;; This package provides a minor mode, compatible with all major
-;; editing modes, for folding (hiding) parts of the edited text or
-;; program.
-;;
-;; Folding mode handles a document as a tree, where each branch
-;; is bounded by special markers `{{{' and `}}}'. A branch can be
-;; placed inside another branch, creating a complete hierarchical
-;; structure.
-;;
-;; Folding mode can CLOSE a fold, leaving only the initial `{{{'
-;; and possibly a comment visible.
-;;
-;; It can also ENTER a fold, which means that only the current
-;; fold will be visible, all text above `{{{' and below `}}}'
-;; will be invisible.
-;;
-;; Please note, that the maintainers do not recommend to use only
-;; folding for you your code layout and navigation. Folding.el is
-;; on its best when it can "chunk" large sections of code inside
-;; folds. The larger the chunks, the more the usability of
-;; folding will increase. Folding.el is not meant to hide
-;; individual functions: you may be better served by hideshow.el
-;; or imenu.el (which can parse the function indexes)
-
-;;}}}
-;;{{{ Installation
-
-;; Installation
-;;
-;; To install Folding mode, put this file (folding.el) on your
-;; Emacs `load-path' (or extend the load path to include the
-;; directory containing this file) and optionally byte compile it.
-;;
-;; The best way to install folding is the autoload installation,
-;; so that folding is loaded into your emacs only when you turn on
-;; `folding-mode'. This statement speeds up loading your .emacs
-;;
-;; (autoload 'folding-mode "folding" "Folding mode" t)
-;; (autoload 'turn-off-folding-mode "folding" "Folding mode" t)
-;; (autoload 'turn-on-folding-mode "folding" "Folding mode" t)
-;;
-;; But if you always use folding, then perhaps you want more
-;; traditional installation. Here Folding mode starts
-;; automatically when you load a folded file.
-;;
-;; ;; (setq folding-default-keys-function
-;; ;; 'folding-bind-backward-compatible-keys)
-;;
-;; (if (load "folding" 'nomessage 'noerror)
-;; (folding-mode-add-find-file-hook))
-;;
-;; Folding uses a keymap which conforms with the new Emacs
-;; (started 19.29) style. The key bindings are prefixed with
-;; "C-c@" instead of old "C-c". To use the old keyboard bindings,
-;; uncomment the lines in the the above installation example
-;;
-;; The same folding marks can be used in `vim' editor command
-;; "set fdm=marker".
-;;
-;; Uninstallation
-;;
-;; To remove folding, call `M-x' `folding-uninstall'.
-;;
-;; To read the manual
-;;
-;; At any point you can reach the manual with `M-x'
-;; `finder-commentary' RET folding RET.
-
-;;}}}
-;;{{{ DOCUMENTATION
-
-;; Compatibility
-;;
-;; Folding supports following Emacs flavors:
-;;
-;; Unix Emacs 19.28+ and Win32 Emacs 19.34+
-;; Unix XEmacs 19.14+ and Win32 XEmacs 21.0+
-;;
-;; Compatibility not for old NT Emacs releases
-;;
-;; NOTE: folding version starting from 2.47 gets around this bug
-;; by using adviced kill/yank functions. The advice functions are
-;; only instantiated under problematic NT Emacs versions.
-;;
-;; Windows NT/9x 19.34 - 20.3.1 (i386-*-nt4.0) versions contained
-;; a bug which affected using folding. At the time the bug was
-;; reported by Trey Jackson <trey A T cs berkeley edu>
-;;
-;; If you kill folded area and yank it back, the ^M marks are
-;; removed for some reason.
-;;
-;; Before kill
-;; ;;{{{ fold...
-;;
-;; After yank
-;; ;;{{{ fold all lines together }}}
-;;
-;; Relates packages or modes
-;;
-;; Folding.el was designed to be a content organizer and it is most
-;; suitable for big files. Sometimes people misunderstand the
-;; package's capabilities and try to use folding.el in wrong places,
-;; where some other package would do a better job. Trying to wrap
-;; individual functions inside fold-marks is not where folding is
-;; it's best. Grouping several functions inside a logical fold-block
-;; in the other is. So, to choose a best tool for your need,
-;; here are some suggestions,:
-;;
-;; o Navigating between or hiding individual functions -
-;; use combination of imenu.el, speedbar.el and
-;; hideshow.el
-;; o Organizing large blocks - use folding.el
-;; o For text, `outline-mode' is more non-intrusive than folding.
-;; Look at Emacs NEWS file (`C-x' `n') and you can see beatifully
-;; laid content.
-;;
-;; Tutorial
-;;
-;; To start folding mode, give the command: `M-x' `folding-mode'
-;; `RET'. The mode line should contain the string "Fld" indicating
-;; that folding mode is activated.
-;;
-;; When loading a document containing fold marks, Folding mode is
-;; automatically started and all folds are closed. For example when
-;; loading my init file, only the following lines (plus a few lines
-;; of comments) are visible:
-;;
-;; ;;{{{ General...
-;; ;;{{{ Keyboard...
-;; ;;{{{ Packages...
-;; ;;{{{ Major modes...
-;; ;;{{{ Minor modes...
-;; ;;{{{ Debug...
-;;
-;; To enter a fold, use `C-c @ >'. To show it without entering,
-;; use `C-c @ C-s', which produces this display:
-;;
-;; ;;{{{ Minor modes
-;;
-;; ;;{{{ Follow mode...
-;; ;;{{{ Font-lock mode...
-;; ;;{{{ Folding...
-;;
-;; ;;}}}
-;;
-;; To show everything, just as the file would look like if
-;; Folding mode hadn't been activated, give the command `M-x'
-;; `folding-open-buffer' `RET', normally bound to `C-c' `@'
-;; `C-o'. To close all folds and go to the top level, the
-;; command `folding-whole-buffer' could be used.
-;;
-;; Mouse support
-;;
-;; Folding mode v2.0 introduced mouse support. Folds can be shown
-;; or hidden by simply clicking on a fold mark using mouse button
-;; 3. The mouse routines have been designed to call the original
-;; function bound to button 3 when the user didn't click on a
-;; fold mark.
-;;
-;; The menu
-;;
-;; A menu is placed in the "Tools" menu. Should no Tools menu exist
-;; (Emacs 19.28) the menu will be placed in the menu bar.
-;;
-;; ISearch
-;;
-;; When searching using the incremental search (C-s) facilities,
-;; folds will be automagically entered and closed.
-;;
-;; Problems
-;;
-;; Uneven fold marks
-;;
-;; Oops, I just deleted some text, and a fold mark got deleted!
-;; What should I do? Trust me, you will eventually do this
-;; sometime. the easiest way is to open the buffer using
-;; `folding-open-buffer' (C-c @ C-o) and add the fold mark by
-;; hand. To find mismatching fold marks, the package `occur' is
-;; useful. The command:
-;;
-;; M-x occur RET {{{\|}}} RET
-;;
-;; will extract all lines containing folding marks and present
-;; them in a separate buffer.
-;;
-;; Even though all folding marks are correct, Folding mode
-;; sometimes gets confused, especially when entering and leaving
-;; folds very often. To get it back on track, press C-g a few
-;; times and give the command `folding-open-buffer' (C-c @ C-o).
-;;
-;; Fold must have a label
-;;
-;; When you make a fold, be sure to write some text for the name
-;; of the fold, otherwise there may be an error "extraneous fold
-;; mark..." Write like this:
-;;
-;; ;;{{{ Note
-;; ;;}}}
-;;
-;; instead of
-;;
-;; ;;{{{
-;; ;;}}}
-;;
-;; folding-whole-buffer doesn't fold whole buffer
-;;
-;; If you call commands `folding-open-buffer' and
-;; `folding-whole-buffer' and notice that there are open fold
-;; sections in the buffer, then you have mismatch of folds
-;; somewhere. Run ` M-x' `occur' and type regexp `{{{\|}}}' to
-;; check where is the extra open or closing fold mark.
-;;
-;; Folding and outline modes
-;;
-;; Folding mode is not the same as Outline mode, a major and
-;; minor mode which is part of the Emacs distribution. The two
-;; packages do, however, resemble each other very much. The main
-;; differences between the two packages are:
-;;
-;; o Folding mode uses explicit marks, `{{{' and `}}}', to
-;; mark the beginning and the end of a branch.
-;; Outline, on the other other hand, tries to use already
-;; existing marks, like the `\section' string in a TeX
-;; document.
-;;
-;; o Outline mode has no end marker which means that it is
-;; impossible for text to follow a sub-branch.
-;;
-;; o Folding mode use the same markers for branches on all depths,
-;; Outline mode requires that marks should be longer the
-;; further, down in the tree you go, e.g `\chap', \section',
-;; `\subsection', `\subsubsection'. This is needed to
-;; distinguish the next mark at the current or higher levels
-;; from a sub-branch, a problem caused by the lack of
-;; end-markers.
-;;
-;; o Folding mode has mouse support, you can navigate through a
-;; folded document by clicking on fold marks. (The XEmacs version
-;; of Outline mode has mouse support.)
-;;
-;; o The Isearch facilities of Folding is capable of
-;; automatically to open folds. Under Outline, the the entire
-;; document must be opened prior isearch.
-;;
-;; In conclusion, Outline mode is useful when the document being
-;; edited contains natural markers, like LaTeX. When writing code
-;; natural markers are hard to find, except if you're happy with
-;; one function per fold.
-;;
-;; Future development ideas
-;;
-;; The plan was from the beginning to rewrite the entire package.
-;; Including replacing the core of the program, written using
-;; old Emacs technology (selective display), and replace it with
-;; modern equivalences, like overlays or text-properties for
-;; Emacs and extents for XEmacs.
-;;
-;; It is not likely that any of this will come true considering
-;; the time required to rewrite the core of the package. Since
-;; the package, in it's current state, is much more powerful than
-;; the original, it would be appropriate to write such package
-;; from scratch instead of doing surgery on this one.
-
-;;}}}
-
-;;{{{ Customization
-
-;; Customization: general
-;;
-;; The behavior of Folding mode is controlled mainly by a set of
-;; Emacs Lisp variables. This section will discuss the most
-;; useful ones, for more details please see the code. The
-;; descriptions below assumes that you know a bit about how to
-;; use simple Emacs Lisp and knows how to edit ~/.emacs, your
-;; init file.
-;;
-;; Customization: hooks
-;;
-;; The normal procedure when customizing a package is to write a
-;; function doing the customization. The function is then added
-;; to a hook which is called at an appropriate time. (Please see
-;; the example section below.) The following hooks are
-;; available:
-;;
-;; o `folding-mode-hook'
-;; Called when folding mode is activated.
-;; o `<major mode>-folding-hook'
-;; Called when starting folding mode in a buffer with major
-;; mode set to <major mode>. (e.g. When editing C code
-;; the hook `c-mode-folding-hook' is called.)
-;; o `folding-load-hook'
-;; Called when folding mode is loaded into Emacs.
-;;
-;; Customization: The Mouse
-;;
-;; The variable `folding-behave-table' contains the actions which
-;; should be performed when the user clicks on an open fold, a
-;; closed fold etc. For example, if you prefer to `enter' a fold
-;; rather than `open' it you should rebind this variable.
-;;
-;; The variable `folding-default-mouse-keys-function' contains
-;; the name of the function used to bind your mouse keys. To use
-;; your own mouse bindings, create a function, say
-;; `my-folding-bind-mouse', and set this variable to it.
-;;
-;; Customization: Keymaps
-;;
-;; When Emacs 19.29 was released, the keymap was divided into
-;; strict parts. (This division existed before, but a lot of
-;; packages, even the ones delivered with Emacs, ignored them.)
-;;
-;; C-c <letter> -- Reserved for the users private keymap.
-;; C-c C-<letter> -- Major mode. (Some other keys are
-;; reserved as well.)
-;; C-c <Punctuation Char> <Whatever>
-;; -- Reserved for minor modes.
-;;
-;; The reason why `C-c@' was chosen as the default prefix is that
-;; it is used by outline-minor-mode. It is not likely that few
-;; people will try to use folding and outline at the same time.
-;;
-;; However, old key bindings have been kept if possible. The
-;; variable `folding-default-keys-function' specifies which
-;; function should be called to bind the keys. There are various
-;; function to choose from how user can select the keybindings.
-;; To use the old key bindings, add the following line to your
-;; init file:
-;;
-;; (setq folding-default-keys-function
-;; 'folding-bind-backward-compatible-keys)
-;;
-;; To define keys similar to the keys used by Outline mode, use:
-;;
-;; (setq folding-default-keys-function
-;; 'folding-bind-outline-compatible-keys)
-;;
-;; Customization: adding new major modes
-;;
-;; To add fold marks for a new major mode, use the function
-;; `folding-add-to-marks-list'. The command also replaces
-;; existing marks. An example:
-;;
-;; (folding-add-to-marks-list
-;; 'c-mode "/* {{{ " "/* }}} */" " */" t)
-;;
-;; Customization: ISearch
-;;
-;; If you don't like the extension folding.el applies to isearch,
-;; set the variable `folding-isearch-install' to nil before
-;; loading this package.
-
-;;}}}
-;;{{{ Examples
-
-;; Example: personal setup
-;;
-;; To define your own key binding instead of using the standard
-;; ones, you can do like this:
-;;
-;; (setq folding-mode-prefix-key "\C-c")
-;; ;;
-;; (setq folding-default-keys-function
-;; '(folding-bind-backward-compatible-keys))
-;; ;;
-;; (setq folding-load-hook 'my-folding-load-hook)
-;;
-;;
-;; (defun my-folding-load-hook ()
-;; "Folding setup."
-;;
-;; (folding-install) ;; just to be sure
-;;
-;; ;; ............................................... markers ...
-;;
-;; ;; Change text-mode fold marks. Handy for quick
-;; ;; sh/perl/awk code
-;;
-;; (defvar folding-mode-marks-alist nil)
-;;
-;; (let* ((ptr (assq 'text-mode folding-mode-marks-alist)))
-;; (setcdr ptr (list "# {{{" "# }}}")))
-;;
-;; ;; ........................................ bindings ...
-;;
-;; ;; Put `folding-whole-buffer' and `folding-open-buffer'
-;; ;; close together.
-;;
-;; (defvar folding-mode-prefix-map nil)
-;;
-;; (define-key folding-mode-prefix-map "\C-w" nil)
-;; (define-key folding-mode-prefix-map "\C-s"
-;; 'folding-show-current-entry)
-;; (define-key folding-mode-prefix-map "\C-p"
-;; 'folding-whole-buffer))
-;;
-;; Example: changing default fold marks
-;;
-;; In case you're not happy with the default folding marks, you
-;; can change them easily. Here is an example
-;;
-;; (setq folding-load-hook 'my-folding-load-hook)
-;;
-;; (defun my-folding-load-hook ()
-;; "Folding vars setup."
-;; ;; Change marks for 'text-mode'
-;; (let* ((ptr (assq 'text-mode folding-mode-marks-alist)))
-;; (setcdr ptr (list "# {{{" "# }}}"))))
-;;
-;; Example: choosing different fold marks for mode
-;;
-;; Suppose you sometimes want to use different fold marks for the
-;; major mode: e.g. to alternate between "# {{{" and "{{{" in
-;; `text-mode' Call `M-x' `my-folding-text-mode-setup' to change
-;; the marks.
-;;
-;; (defun my-folding-text-mode-setup (&optional use-custom-folding-marks)
-;; (interactive
-;; (list (y-or-n-p "Use Custom fold marks now? ")))
-;; (let* ((ptr (assq major-mode folding-mode-marks-alist))
-;; (default-begin "# {{{")
-;; (default-end "# }}}")
-;; (begin "{{{")
-;; (end "}}}"))
-;; (when (eq major-mode 'text-mode)
-;; (unless use-custom-folding-marks
-;; (setq begin default-begin end default-end)))
-;; (setcdr ptr (list begin end))
-;; (folding-set-marks begin end)))
-;;
-;; Example: AucTex setup
-;;
-;; Suppose you're using comment.sty with AucTeX for editing
-;; LaTeX2e documents and you have these comment types. You would
-;; like to be able to set which of these 3 is to be folded at any
-;; one time, using a simple key sequence: move back and forth
-;; easily between the different comment types, e.g., "unfold
-;; everything then fold on \x".
-;;
-;; \O ... \endO
-;; \L ... \endL
-;; \B ... \endB
-;;
-;; (setq folding-load-hook 'my-folding-load-hook)
-;;
-;; (defun my-folding-load-hook ()
-;; "Folding vars setup."
-;; (let ((ptr (assq 'text-mode folding-mode-marks-alist)))
-;; (setcdr ptr (list "\\O" "\\endO"))
-;; (define-key folding-mode-prefix-map "C"
-;; 'my-folding-marks-change)))
-;;
-;; (defun my-folding-marks-change (&optional selection)
-;; "Select folding marks: prefixes nil, C-u and C-u C-u."
-;; (interactive "P")
-;; (let ((ptr (assq major-mode folding-mode-marks-alist))
-;; input)
-;; (when (string-match "^\\(plain-\\|la\\|auc\\)?tex-"
-;; (symbol-name major-mode))
-;; (setq input
-;; (read-string "Latex \\end(X) Marker (default O): "
-;; nil nil "O" nil))
-;; (setq input (upcase input))
-;; (turn-off-folding-mode)
-;; (folding-add-to-marks-list
-;; major-mode
-;; (concat "\\" input) (concat "\\end" input) nil nil t)
-;; ;; (setcdr ptr (list (concat "\\" input) (concat "\\end" input)))
-;; (turn-on-folding-mode))))
-;; ;; End of example
-;;
-;; Bugs: Lazy-shot.el conflict in XEmacs
-;;
-;; [XEmacs 20.4 lazy-shot-mode]
-;; 1998-05-28 Reported by Solofo Ramangalahy <solofo A T mpi-sb mpg de>
-;;
-;; % xemacs -q folding.el
-;; M-x eval-buffer
-;; M-x folding-mode
-;; M-x font-lock-mode
-;; M-x lazy-shot-mode
-;; C-s mouse
-;;
-;; then search for mouse again and again. At some point you will
-;; see "Deleting extent" in the minibuffer and XEmacs freezes.
-;;
-;; The strange point is that I have this bug only under Solaris
-;; 2.5 sparc (binaries from ftp.xemacs.org) but not under Solaris
-;; 2.6 x86. (XEmacs 20.4, folding 2.35). I will try to access
-;; more machines to see if it's the same.
-;;
-;; I suspect that the culprit is lazy-shot as it is beta, but
-;; maybe you will be able to describe the bug more precisely to
-;; the XEmacs people I you can reproduce it.
-
-;;}}}
-;;{{{ Old Documentation
-
-;; Old documentation
-;;
-;; The following text was written by Jamie Lokier for the release
-;; of Folding V1.6. It is included here for no particular reason:
-;;
-;; Emacs 18:
-;; Folding mode has been tested with versions 18.55 and
-;; 18.58 of Emacs.
-;;
-;; Epoch:
-;; Folding mode has been tested on Epoch 4.0p2.
-;;
-;; [X]Emacs:
-;; There is code in here to handle some aspects of XEmacs.
-;; However, up to version 19.6, there appears to be no way to
-;; display folds. Selective-display does not work, and neither do
-;; invisible extents, so Folding mode has no chance of
-;; working. This is likely to change in future versions of
-;; XEmacs.
-;;
-;; Emacs 19:
-;; Tested on version 19.8, appears to be fine. Minor bug:
-;; display the buffer in several different frames, then move in
-;; and out of folds in the buffer. The frames are automatically
-;; moved to the top of the stacking order.
-;;
-;; Some of the code is quite horrible, generally in order to
-;; avoid some Emacs display "features". Some of it is specific to
-;; certain versions of Emacs. By the time Emacs 19 is around and
-;; everyone is using it, hopefully most of it won't be necessary.
-;;
-;; More known bugs
-;;
-;; *** Needs folding-fold-region to be more intelligent about
-;; finding a good region. Check folding a whole current fold.
-;;
-;; *** Now works with 19! But check out what happens when you
-;; exit a fold with the file displayed in two frames. Both
-;; windows get fronted. Better fix that sometime.
-;;
-;; Future features
-;;
-;; *** I will add a `folding-next-error' sometime. It will only
-;; work with Emacs versions later than 18.58, because compile.el
-;; in earlier versions does not count line-numbers in the right
-;; way, when selective display is active.
-;;
-;; *** Fold titles should be optionally allowed on the closing
-;; fold marks, and `folding-tidy-inside' should check that the
-;; opening title matches the closing title.
-;;
-;; *** `folded-file' set in the local variables at the end of a
-;; file could encode the type of fold marks used in that file,
-;; and other things, like the margins inside folds.
-;;
-;; *** I can see a lot of use for the newer features of Emacs 19:
-;;
-;; Using invisible text-properties (I hope they are intended to
-;; make text invisible; it isn't implemented like that yet), it
-;; will be possible to hide folded text without affecting the
-;; text of the buffer. At the moment, Folding mode uses selective
-;; display to hide text, which involves substituting
-;; carriage-returns for line-feeds in the buffer. This isn't such
-;; a good way. It may also be possible to display different folds
-;; in different windows in Emacs 19.
-;;
-;; Using even more text-properties, it may be possible to track
-;; pointer movements in and out of folds, and have Folding mode
-;; automatically enter or exit folds as necessary to maintain a
-;; sensible display. Because the text itself is not modified (if
-;; overlays are used to hide text), this is quite safe. It would
-;; make it unnecessary to provide functions like
-;; `folding-forward-char', `folding-goto-line' or
-;; `folding-next-error', and things like I-search would
-;; automatically move in and out of folds as necessary.
-;;
-;; Yet more text-properties/overlays might make it possible to
-;; avoid using narrowing. This might allow some major modes to
-;; indent text properly, e.g., C++ mode.
-
-;;}}}
-
-;;; Change Log:
-
-;;{{{ History
-
-;; [person version] = developer and his revision tree number.
-;;
-;; Sep 20 2009 23.1 [jari git a80c2d6]
-;; - Remove 'defmacro custom' for very old Emacs version that did
-;; not have custom.
-;; - Modernize all macros to use new backquote syntax,
-;; - Move `folding-narrow-by-default' variable
-;; definition before `folding-advice-instantiate' which
-;; refers to it.
-;;
-;; Feb 20 2009 22.2.1 [jari git 51ada03..56b3089]
-;; - Make XEmacs CVS and Savannah git revisions at header more clear
-;; - Unify html-mode folds as in other modes: change [[[ ]]] to {{{ }}}
-;;
-;; Feb 09 2009 22.2.1 [jari git e0c2e92..6a3cff7]
-;; - Minor documentaton fixes.
-;; - Add new `python-mode' using `folding-add-to-marks-list'.
-;; - Add new variable `folding-version-time' to record edit time.
-;; Value is automatically updated by developer's Emacs setup.
-;;
-;; May 06 2007 21.4 [jari 3.38-3.41 2007.0506]
-;; - Cleanup. Eol whitespaces removed, extra newlines cleaned.
-;; Paren positions corrected.
-;; - 'Personal reflections by Anders Lindgren' topic
-;; rephrased 'Future development ideas'
-;; - (folding-show-current-entry): Run `font-lock-fontify-region'
-;; after opening the fold. Font-lock.el treated all closed folds
-;; as comments.
-;;
-;; Nov 16 2006 21.4 [jari 3.36-3.37 2006.1118]
-;; - Jeremy Hankins <nowan A T nowan org> sent a patch, which
-;; adds variable `folding-narrow-by-default'. The patch affects
-;; mostly `folding-shift-in'. This makes it possible to
-;; advise viper-search to open folds. Thanks.
-;; - Added VCS URL header to the beginning for canonnical location.
-;; Updated maintainer section.
-;; - Fixed Copyright years.
-;;
-;; Nov 25 2004 21.3 [jari 3.35 2004.1125]
-;; - non-ascii character removed from bibtex-mode.
-;; Changed bib-mode '@comment' => '%'. Closes Debian
-;; Bug#282388
-;;
-;; Sep 10 2004 21.3 [jari 2.116 2004.0910]
-;; - (folding-fold-region): caused to indent bottom fold
-;; some 50 spaces forward in auctex:latex-mode. Disabled
-;; running `indent-according-to-mode' while in latex-mode.
-;; Bug reported by Uwe Brauer; oub A T mat dot ucm dot es
-;; - Removed extra newlines from whole buffer.
-;; - Changed version scheme to date based YYYY.MMDD
-;; - Removed unnecessary 'all rights reserved'.
-;; - (folding-check-folded): Added check for \r character, which
-;; - protected all email addresses by removing AT-signs.
-;;
-;; Apr 01 2004 21.3 [jari 2.111-2.115]
-;; - Merged in changes made by 2003-11-12 Adrian Aichner
-;; from XEmacs tree 1.15; Typo fixes for docstrings and comments.
-;; - Returned to old bug and solved it in a better way (preserve region) by
-;; using different expansion macros for XEmacs and Emacs.
-;; See See http://list-archive.xemacs.org/xemacs-beta/199810/msg00039.html
-;; - (folding-forward-char-1): 2.112 Renamed.
-;; Was `folding-forward-char'.
-;; (folding-backward-char-1): 2.112 Renamed.
-;; Was `folding-backward-char'.
-;; (folding-forward-char-macro): 2.112 New. Fix XEmacs
-;; region preservation with '_p' interactive spec.
-;; (folding-backward-char-macro): 2.112 New. Fix XEmacs
-;; region preservation with '_p' interactive spec.
-;; (folding-interactive-spec-p): 2.112 New.
-;;
-;; Sep 11 2003 21.2 [jari 2.107-2.111]
-;; - Added new sections "Uninstallation" and "To read the manual".
-;; M-x finder can invoke folding too provided that patch to
-;; lisp-mnt.el and finder.el is installed. Sent patch to XEmacs and
-;; Emacs developers.
-;; - Moved fold-mark ";;{{{ Introduction" after the Commentary:
-;; tag to have it included in M-x finder-commentary.
-;; - If called like this: `folding-uninstall' and immediately
-;; `folding-mode', the keybindings were not there any more. Added
-;; call to `folding-install' in `folding-mode'.
-;; - Completely rewrote `folding-install'. It's now divided into
-;; `folding-install-keymaps' and `folding-uninstall-keymaps'
-;; - Added support for `php-mode', `javascript-mode',
-;; `change-log-mode' and `finder-mode'.
-;; - Documentation changes (fit all to 80 characters).
-;;
-;; Aug 21 2002 21.2 [jari 2.105-2.106]
-;; - Added user function `folding-uninstall'.
-;; - Removed `interactive' status: `folding-install-hooks' and
-;; `folding-uninstall-hooks'
-;;
-;; Aug 02 2002 20.7 [jari 2.101-2.104]
-;; - Added font lock support. Now beginning and end markers are
-;; highlighted with user variables `folding-font-lock-begin-mark'
-;; `folding-font-lock-end-mark'. Feature suggested by
-;; <Claude BOUCHER A T astrium-space com>
-;; - Removed LCD entry - unnecessary.
-;;
-;; Jan 24 2002 20.7 [jari 2.100]
-;; - (folding-context-next-action):New user function.
-;; Code by Scott Evans <gse A T antisleep com>
-;; - (folding-bind-default-keys): Added
-;; C-x . to run `folding-context-next-action'
-;; - (folding-mouse-call-original): Added `car-safe' to read
-;; EVENT, which may be nil.
-;;
-;; Jul 31 2001 20.7 [jari 2.98-2.99]
-;; - Gleb Arshinov <gleb A T barsook com> fixed the broken XEmacs
-;; isearch support and sent nice patch.
-;;
-;; Jul 19 2001 20.7 [jari 2.92-2.97]
-;; - Beautified lisp code by removing parens that were alone.
-;; - XEmacs latex-mode fix. The folds were strangely indented too
-;; far right. The cause was `indent-according-to-mode' which is
-;; now disabled in latex. bug reported by
-;; Uwe Brauer; oub A T maraton sim ucm es
-;; - 2.96 Erroneous `:' in `folding-mode-write-file'
-;; when it should have been `;'. Bug reported by
-;; Brand Michael; michael brand A T siemens com
-;;
-;; Apr 04 2001 20.7 [jari 2.89-2.91]
-;; - Small corrections to find-func.el::find-function-search-for-symbol
-;; implementation.
-;;
-;; Mar 08 2001 20.6 [jari 2.88]
-;; - Dave Masterson <dmasters A T rational com> reported that jumping to a
-;; url displayed by the C-h f FUNCTION which told where the function
-;; was located died. The reason was that the buffer was folded and
-;; find-func.el::find-function-search-for-symbol used regexps that
-;; do not take into account folded buffers. The regexps used there
-;; rely on syntax tables.
-;; - Added two new advices to catch find-func.el and unfold the buffer
-;; prior searching: (advice find-file-noselect after) and (advice
-;; find-function-search-for-symbol around)
-;;
-;; Mar 04 2001 20.6 [jari 2.83-2.87]
-;; - Added ###autoload statements, tidied up empty lines and lisp syntax.
-;; - Run checkdoc.el 0.6.1 and corrected errors.
-;;
-;; Jan 04 2001 20.6 [jari 2.82]
-;; - Added FOLD highlight feature for XEmacs:
-;; `folding-mode-motion-highlight-fold'
-;; and package `mode-motion' Suggested by
-;; Thomas Ruhnau <thomas ruhnau A T intermetall de>
-;; - (folding-bind-default-keys): 2.81 New binding C-k
-;; `folding-marks-kill'
-;; (fold-marks-kill): 2.81 New.
-;;
-;; Jan 03 2001 20.6 [jari 2.81]
-;; - (folding-folding-region): 2.80 Renamed to `folding-fold-region'
-;; - (folding-mark-look-at-top-mark-p): 2.80 New.
-;; - (folding-mark-look-at-bottom-mark-p): 2.80 New.
-;; - (folding-tidy-inside): 2.80 Use `folding-mark-look-at-top-mark-p'
-;; and `folding-mark-look-at-bottom-mark-p'.
-;; - Didn't accept spaces in front of fold markers.
-;; - (folding-fold-region): 2.80 Added `indent-according-to-mode'
-;; to indent folds as needed.
-;;
-;; Dec 16 2000 20.6 [jari 2.79-2.80]
-;; - `folding-xemacs-p' now test (featurep 'xemacs)
-;; - Added missing folding functions to the menubar
-;; - `folding-package-url-location' new variable used by function
-;; `folding-insert-advertise-folding-mode'
-;; - `folding-keep-hooked' was commented out in `folding-mode'. Added
-;; back.
-;;
-;; Jul 25 2000 20.6 [jari 2.76-2.78]
-;; - 2.75 Added support for modes:
-;; xrdb-mode, ksh-mode and sql-mode contributed by
-;; Juhapekka Tolvanen <juhtolv A T st jyu fi>. Scanned systematically
-;; all modes under Emacs 20.6 progmodes and added support for:
-;; ada-mode, asm-mode, awk-mode, cperl-mode, fortran-mode, f90-mode,
-;; icon-mode, m4-mode, meta-mode, pascal-mode, prolog-mode,
-;; simula-mode, vhdl-mode, bibtex-mode, nroff-mode, scribe-mode(*),
-;; sgml-mode
-;; - Mode marked with (*) was not added.
-;; - (folding-insert-advertise-folding-mode): 2.76 New. Suggested by
-;; Juhapekka Tolvanen <juhtolv A T st jyu fi>
-;; - (folding-bind-default-keys): 2.76
-;; folding-insert-advertise-folding-mode Bound to key "I"
-;;
-;; Apr 24 1999 20.4 [jari 2.73-2.75]
-;; - (folding-bind-terminal-keys): 2.74 New. Bind C-f and C-b only at
-;; non-window system where they are really needed. Someone may use
-;; C-f for `isearch-forward' in windowed Emacs.
-;; - (folding-bind-default-keys): 2.74 Use `folding-bind-terminal-keys'
-;; - (folding-bind-outline-compatible-keys): 2.74
-;; Use `folding-bind-terminal-keys'
-;;
-;; Feb 13 1999 20.4 [jari 2.71-2.72]
-;; - (folding-event-posn): 2.70 Wrong
-;; place of paren and the following was malformed call:
-;; (let* ((el (funcall (symbol-function 'event-start) event)))
-;;
-;; Jan 13 1999 20.4 [jari 2.70]
-;; - 2.69 The `looking-at' is now smarter with
-;; fold beginning marks. The tradition has been the the fold always
-;; has a name, so the requirement to search fold is "{{{ ". Now
-;; the " " is searched as " *", not requiring a space --> not requiring
-;; a fold name.
-;; - (folding-skip-folds): >>feature not not enabled<<
-;; 2.69 Do not require trailing " " any more.'
-;; (folding-tidy-inside): >>feature not not enabled<<
-;; 2.69 Do not require trailing " " any more.
-;; - (folding-install): 2.69 Fixed indentation.
-;; - (folding-mark-look-at): 2.69 The "em" missed "*" and thus pressing
-;; mouse-3 at the end-fold didn't collapse the whole fold.
-;;
-;; Jan 12 1999 20.4 [jari 2.69]
-;; (folding-bind-default-mouse): 2.68
-;; XEmacs and Emacs Mouse binding was different. Now use common
-;; bindings: The S-mouse-2 was superfluous, because mouse-3 already
-;; did that, so the binding was removed.
-;; mouse-3 folding-mouse-context-sensitive
-;; S-mouse-2 folding-hide-current-entry
-;; C-S-mouse-2 folding-mouse-pick-move
-;;
-;;;; Jan 09 1999 20.4 [jari 2.67-2.68]
-;; - (folding-event-posn): 2.66 Hide `event-start' From XEmacs
-;; (byte compile silencer)
-;;
-;; Jan 07 1999 20.4 [jari 2.65-2.66]
-;; - The Folding begin and AND mark was not case sensitive;
-;; that's why a latex styles "\B" and "\endB" fold marks couldn't
-;; be used. Added relevant `case-fold-search' settings. Not tested
-;; very well, though.
-;; - Added standard "turn-on" "turn-off" functions.
-;; - (folding-whole-buffer): 2.65 Better
-;; Error message. Show used folding-mark on error.
-;; - (folding-skip-folds): 2.65 Moved docs in function.
-;; - (turn-off-folding-mode): 2.65 New.
-;; - (turn-on-folding-mode): 2.65 New.
-;; - (folding-mark-look-at): 2.65 `case-fold-search'
-;; - (folding-next-visible-heading): 2.65 `case-fold-search'
-;; - (folding-find-folding-mark): 2.65 `case-fold-search'
-;; - (folding-pick-move): 2.65 `case-fold-search'
-;; - (folding-skip-folds): 2.65 `case-fold-search'
-;; - (folding-tidy-inside): 2.65 `case-fold-search'
-;; - (folding-convert-to-major-folds): 2.65 `case-fold-search'
-;;
-;; Jan 04 1999 20.4 [jari 2.62-2.64]
-;; - (folding-set-local-variables): 2.61 New. Now it is possible to
-;; change the folding marks dynamically.
-;; - (folding-mode): 2.61 Call `folding-set-local-variables'
-;; (folding-mode-marks-alist): 2.61 mention
-;; - `folding-set-local-variables'
-;; Added documentation section: "Example: AucTex setup"
-;; - NT Emacs fix wrapped inside `eval-and-compile'. hs-discard-overlays
-;; are now hidden from byte compiler (since the code is not
-;; executed anyway)
-;;
-;; May 24 1999 19.34 [jari 2.59-2.61]
-;; - New function `folding-all-comment-blocks-in-region'. Requested by
-;; Uwe Brauer <oub A T eucmos sim ucm es>. Bound under "/" key.
-;; - (folding-all-comment-blocks-in-region):
-;; Check non-whitespace `comment-end'. Added `matlab-mode' to
-;; fold list
-;; - (folding-event-posn): 2.63 Got rid of the XEmacs/Emacs
-;; posn-/event- byte compiler warnings
-;; - (folding-mouse-call-original): 2.63 Got rid of the XEmacs
-;; `event-button' byte compiler warning.
-;;
-;; Apr 15 1999 19.34 [jari 2.57]
-;; - (folding-mouse-call-original): Samuel Mikes
-;; <smikes A T alumni hmc edu> reported that the `concat' function was
-;; used to add an integer to "button" event. Applied patch to use
-;; `format' instead.
-;;
-;; Mar 03 1999 19.34 [andersl]
-;; - (folding-install): had extra paren. Removed.
-;;
-;; Feb 22 1999 19.34 [jari 2.56]
-;; - folding-install):
-;; Check if `folding-mode-prefix-map' is nil and call
-;;
-;; Feb 19 1999 19.34 [jari 2.55]
-;; - (folding-mode-hook-no-re):
-;; Renamed to `folding-mode-hook-no-regexp'
-;; - (fold-inside-mode-name): Renames to `folding-inside-mode-name'
-;; (fold-mode-string): Renamed to `folding-mode-string'
-;; - Renamed all `fold-' prefixes to `folding-'
-;; - Rewrote chapter `Example: personal setup'
-;;
-;; Jan 01 1999 19.34 [jari 2.54]
-;; - Byte compiler error fix: (folding-bind-outline-compatible-keys):
-;; 'folding-show-all lacked the quote.
-;;
-;; Dec 30 1998 19.34 [jari 2.53]
-;; - Jesper Pedersen <blackie A T imada ou dk> reported bug that hiding
-;; subtree was broken. This turned out to be a bigger problem in fold
-;; handling in general. This release has big relatively big error
-;; fixes.
-;; - Many of the folding functions were also renamed to mimic Emacs 20.3
-;; allout.el names. Outline keybindings were rewritten too.
-;; - folding.el (folding-mouse-yank-at-point): Renamed from
-;; `folding-mouse-operate-at-point'. The name is similar to Emacs
-;; standard variable name. The default value changed from nil --> t
-;; according to suggestion by Jesper Pedersen <blackie A T imada ou dk>
-;; Message "Info, Ignore [X]Emacs specific..." is now displayed only
-;; while byte compiling file.
-;; (folding-bind-outline-compatible-keys):
-;; Checked the Emacs 20.3 allout.el outline bindings and made
-;; folding mimic them
-;; (folding-show-subtree): Renamed to `folding-show-current-subtree'
-;; according to allout.el
-;; (folding-hide-subtree): Renamed to `folding-hide-current-subtree'
-;; according to allout.el
-;; (folding-enter): Renamed to `folding-shift-in'
-;; according to allout.el
-;; (folding-exit): Renamed to `folding-shift-out'
-;; according to allout.el
-;; (folding-move-up): Renamed to `folding-previous-visible-heading'
-;; according to allout.el
-;; (folding-move): Renamed to `folding-next-visible-heading'
-;; according to allout.el
-;; (folding-top-level): Renamed to `folding-show-all'
-;; according to allout.el
-;; (folding-show): Renamed to `folding-show-current-entry'
-;; according to allout.el
-;; (folding-hide): Renamed to `folding-hide-current-entry'
-;; according to allout.el
-;; (folding-region-open-close): While loop rewritten so that if user
-;; is already on a fold mark, then close current fold. This also
-;; fixed the show/hide subtree problem.
-;; (folding-hide-current-subtree): If use hide subtree that only had
-;; one fold, then calling this function caused error. The reason was
-;; error in `folding-pick-move' (folding-pick-move): Test that
-;; `moved' variable is integer and only then move point. This is the
-;; status indicator from `folding-find-folding-mark'
-;; (folding-find-folding-mark): Fixed. mistakenly moved point when
-;; checking TOP level marker, status 11. the point was permanently
-;; moved to point-min.
-;;
-;; Dec 29 1998 19.34 [jari 2.51]
-;; - Jesper Pedersen <blackie A T imada ou dk> reported that prefix key
-;; cannot take vector notation [(key)]. This required changing the way
-;; how folding maps the keys. Now uses intermediate keymap
-;; `folding-mode-prefix-map'
-;; - `folding-kbd' is new.
-;; - `folding-mode' function description has better layout.
-;; - `folding-get-mode-marks' is now defsubst.
-;;
-;; Dec 13 1998 19.34 [jari 2.49-2.50]
-;; - Gleb Arshinov <gleb A T CS Stanford EDU> reported that the XEmacs 21.0
-;; `concat' function won't accept integer argument any more and
-;; provided patch for `folding-set-mode-line'.
-;;
-;; Nov 28 1998 19.34 [jari 2.49-2.50]
-;; - Gleb Arshinov <gleb A T CS Stanford EDU> reported that the
-;; zmacs-region-stays must not be set globally but in the functions
-;; that need it. He tested the change on tested on XEmacs 21.0 beta
-;; and FSF Emacs 19.34.6 on NT and sent a patch . Thank you.
-;; - (folding-preserve-active-region): New macro to set
-;; `zmacs-region-stays' to t in XEmacs.
-;; - (folding-forward-char): Use `folding-preserve-active-region'
-;; - (folding-backward-char): Use `folding-preserve-active-region'
-;; - (folding-end-of-line): Use `folding-preserve-active-region'
-;; - (folding-isearch-general): Variables `is-fold' and
-;; `is narrowed' removed, because they were not used. (Byte
-;; Compilation fix)
-;; - Later: interestingly using `defmacro'
-;; folding-preserve-active-region does not work in XEmacs 21.0 beta,
-;; but `defsubst' does. Reported and corrected by Gleb.
-;;
-;; Oct 22 1998 19.34 [jari 2.47-2.48]
-;; - NT Emacs has had long time a bug where it strips away ^M when
-;; closed fold is copied to kill ring. When pasted, then ^M are
-;; gone. This cover NT Emacs releases 19.34 - 20.3. Bug report has
-;; been filed.
-;; - to cope with the situation I added new advice functions that
-;; get instantiated only for these versions of NT Emacs. See
-;; `kill-new' and `current-kill'
-;;
-;; Oct 21 1998 19.34 [jari 2.46]
-;; - `folding-isearch-general' now enters folds as usual with isearch.
-;; The only test needed was to check `quit-isearch' before calling
-;; `folding-goto-char', because the narrow case was already taken
-;; cared of in the condition case.
-;;
-;; Oct 19 1998 19.34 [jari 2.44]
-;; - 1998-10-19 Uwe Brauer <oub A T sunma4 mat ucm es> reported that
-;; In Netscape version > 4 the {{{ marks cannot be used. For IE they
-;; were fine, but not for Netscape. Some bug there.
-;; --> Marks changed to [[[ ]]]
-;;
-;; Oct 5 1998 19.34 [jari 2.43]
-;; - The "_p" flag does not exist in Emacs 19.34, so the previous patch
-;; was removed. <greg A T alphatech com> (Greg Klanderman) suggested using
-;; `zmacs-region-stays'. Added to the beginning of file.
-;; - todo: folding does not seem to open folds any more with Isearch.
-;;
-;; Oct 5 1998 19.34 [jari 2.42]
-;; - Gleb Arshinov <gleb A T cs stanford edu> reported (and supplied patch):
-;; I am using the latest beta of folding.el with XEmacs 21.0 "Finnish
-;; Landrace" [Lucid] (i386-pc-win32) (same bug is present with folding.el
-;; included with XEmacs). Being a big fan of zmacs-region, I was
-;; disappointed to find that folding mode caused my usual way of
-;; selecting regions (e.g. to select a line C-space, C-a, C-e) to break
-;; :( I discovered that the following 3 functions would unset my mark.
-;; Upon reading some documentation, this seems to be caused by an
-;; argument to interactive used by these functions. With the following
-;; tiny patch, the undesirable behaviour is gone.
-;; - Patch was applied as is. Function affected:
-;; `folding-forward-char' `folding-backward-char'
-;; `folding-end-of-line'. Interactive spec changed from "p" to "_p"
-;;
-;; Sep 28 1998 19.34 [jari 2.41]
-;; - Wrote section "folding-whole-buffer doesn't fold whole buffer" to
-;; Problems topic. Fixed some indentation in documentation so that
-;; command ripdoc.pl folding.el | t2html.pl --simple > folding.html
-;; works properly.
-;;
-;; Sep 24 1998 19.34 [jari 2.40]
-;; - Stephen Smith <steve A T fmrib ox ac uk> wished that the
-;; `folding-comment-fold' should handle modes that have comment-start
-;; and comment-end too. That lead to rewriting the comment function so
-;; that it can be adapted to new modes.
-;; - `folding-pick-move' didn't work in C-mode. Fixed.
-;; (folding-find-folding-mark):
-;; m and re must be protected with `regexp-quote'. This
-;; corrected error eg. in C-mode where `folding-pick-move'
-;; didn't move at all.
-;; (folding-comment-fold): Added support for major modes that
-;; have `comment-start' and `comment-end'. Use
-;; `folding-comment-folding-table'
-;; (folding-comment-c-mode): New.
-;; (folding-uncomment-c-mode): New.
-;; (folding-comment-folding-table): New. To adapt to any major-mode.
-;; (folding-uncomment-mode-generic): New.
-;; (folding-comment-mode-generic): New.
-;;
-;; Aug 08 1998 19.34 [jari 2.39]
-;; - Andrew Maccormack <andrewm A T bristol st com> reported that the
-;; `em' end marker that was defined in the `let' should also have
-;; `[ \t\n]' which is in par with the `bm'. This way fold markers do
-;; not need to be parked to the left any more.
-;;
-;; Jun 05 1998 19.34 [jari 2.37-2.38]
-;; - Alf-Ivar Holm <affi A T osc no> send functions
-;; `folding-toggle-enter-exit' and `folding-toggle-show-hide' which
-;; were integrated. Alf also suggested that Fold marks should now
-;; necessarily be located at the beginning of line, but allow spaces
-;; at front. The patch was applied to `folding-mark-look-at'
-;;
-;; Mar 17 1998 19.34 [Anders]
-;; - Anders: This patch fixes one problem that was reported in the
-;; beginning of May by Ryszard Kubiak <R Kubia A T ipipan gda pl>.
-;; - Finally, I think that I have gotten mouse-context-sensitive
-;; right. Now, when you click on a fold that fold rather than the
-;; one the cursor is on is used, while still not breaking commands
-;; like `mouse-save-then-kill' which assumes that the point hasn't
-;; been moved.
-;; - Jari: Added topic "Fold must have a label" to the Problem section.
-;; as reported by Solofo Ramangalahy <solofo A T mpi-sb mpg de>
-;; - 1998-05-04 Ryszard Kubiak <R Kubiak A T ipipan gda pl> reported: I am
-;; just curious if it is possible to make Emacs' cursor
-;; automatically follow a mouse-click on the {{{ and }}} lines. I
-;; mean by this that a [S-mouse-3] (as defined in my settings below
-;; --- I keep not liking overloading [mouse-3]) first moves the
-;; cursor to where the click happened and then hides or shows a
-;; folded area. I presume that i can write a two-lines long
-;; interactive function to do this. Still, may be this kind of mouse
-;; behaviour is already available.
-;;
-;; Mar 17 1998 19.34 [Jari 2.34-2.35]
-;; - Added "Example: choosing different fold marks for mode"
-;; - corrected `my-folding-text-mode-setup' example.
-;;
-;; Mar 10 1998 19.34 [Jari 2.32-2.33]
-;; - [Anders] responds to mouse-3 handling problem: I have found the
-;; cause of the problem, and I have a suggestion for a fix.
-;;
-;; The problem is caused by two things:
-;; * The "mouse-save-then-kill" checks that the previous command also
-;; was "mouse-save-then-kill".
-;;
-;; * The second (more severe) problem is that
-;; "folding-mouse-context-sensitive" sets the point to the
-;; location of the click, effectively making
-;; "mouse-save-then-kill" mark the area between the point and the
-;; point! (This is why no region appears.)
-;;
-;; The first problem can be easily fixed by setting "this-command"
-;; in "folding-mouse-call-original":
-;;
-;; - Now the good old mouse-3 binding is back again.
-;; - (folding-mouse-context-sensitive): Added `save-excursion' as
-;; Anders suggested before setting `state'.
-;; (folding-mouse-call-original): commented out experimental code and
-;; used (setq this-command orig-func) as Anders suggested.
-;;
-;; Mar 10 1998 19.34 [Jari 2.31]
-;; - (folding-act): Added `event' to `folding-behave-table' calls.
-;; Input argument takes now `event' too
-;; - (folding-mouse-context-sensitive): Added argument `event'
-;; - (folding-mouse-call-original): Added (this-command orig-func)
-;; when calling original command.
-;; - (folding-bind-default-mouse): Changed mouse bindings. The
-;; button-3 can't be mapped by folding, because folding is unable to
-;; call the original function `mouse-save-then-kill'. Passing simple
-;; element to `mouse-save-then-kill' won't do the job. Eg if I
-;; (clicked mouse-1) moved mouse pointer to place X and pressed
-;; mouse-3, the area was not highlighted in folding mode. If folding
-;; mode was off the are was highlighted. I traced the
-;; `folding-mouse-call-original' and it was passing exactly the same
-;; event as without folding mode. I have no clue what to do about
-;; it...That's why I removed default mouse-3 binding and left it to
-;; emacs. This bug was reported by Ryszard Kubiak"
-;; <R Kubiak A T ipipan gda pl>
-;;
-;; Feb 12 1998 19.34 [Jari 2.30]
-;; - (html-mode): New mode added to `folding-mode-marks-alist'
-;; - (folding-get-mode-marks): Rewritten, now return 3rd element too.
-;; - (folding-comment-fold): Added note that function with `comment-end'
-;; is not supported. Function will flag error in those cases.
-;; - (folding-convert-to-major-folds): Conversion failed if eg; you
-;; switched between modes that has 2 and 1 comments, like
-;; /* */ (C) and //(C++). Now the conversion is bit smarter, but it's
-;; impossible to convert from /* */ to // directly because we don't
-;; know how to remove */ mark, you see:
-;;
-;; Original mode was C
-;;
-;; /* {{{ */
-;;
-;; And now used changed it to C++ mode, and ran command
-;; `folding-convert-to-major-folds'. We no longer have information
-;; about old mode's beginning or end comment markers, so we only
-;; can convert the folds to format
-;;
-;; // {{{ */
-;;
-;; Where the ending comment mark from old mode is left there.
-;; This is slightly imperfect situation, but at least the fold
-;; conversion works.
-;;
-;; Jan 28 1998 19.34 [Jari 2.25-2.29]
-;; - Added `generic-mode' to fold list, suggested by Wayne Adams
-;; <wadams A T galaxy sps mot com>
-;; - Finally rewrote the awesome menu-bar code: now uses standard
-;; easy-menu Which works in both XEmacs and Emacs. The menu is no
-;; longer under "Tools", but appear when minor mode is turned on.
-;; - Radical changes: Decided to remove all old lucid and epoch
-;; dependencies. Lot of code removed and reprogrammed.
-;; - I also got rid of the `folding-has-minor-mode-map-alist-p' variable
-;; and old 18.xx function `folding-merge-keymaps'.
-;; - Symbol's value as variable is void ((folding-xemacs-p)) error fixed.
-;; - Optimized 60 `folding-use-overlays-p' calls to only 4 within
-;; `folding-subst-regions'. (Used elp.el). It seems that half of the
-;; time is spent in the function `folding-narrow-to-region'
-;; function. Could it be optimized somehow?
-;; - Changed "lucid" tests to `folding-xemacs-p' variable tests.
-;; - Removed `folding-hack' and print message 'Info, ignore missing
-;; functions.." instead. It's better that we see the missing
-;; functions and not define dummy hacks for them.
-;;
-;; Nov 13 1997 19.34 [Jari 2.18-2.24]
-;; - Added tcl-mode fold marks, suggested by Petteri Kettunen
-;; <Petteri Kettunen A T oulu fi>
-;; - Removed some old code and modified the hook functions a bit.
-;; - Added new user function `folding-convert-to-major-folds', key "%".
-;; - Added missing items to Emacs menubar, didn't dare to touch the
-;; XEmacs part.
-;; - `folding-comment-fold': Small fix. commenting didn't work on
-;; closed folds. or if point was on topmost fold.
-;; - Added `folding-advice-instantiate' And corrected byte compiler
-;; message: Warning: variable oldposn bound but not referenced
-;; Warning: reference to free variable folding-stack
-;; - updated (require 'custom) code
-;;
-;; Nov 6 1997 19.34 [Jari 2.17]
-;; - Uwe Brauer <oub A T sunma4 mat ucm es> used folding for Latex files
-;; and he wished a feature that would allow him to comment away ext
-;; that was inside fold; when compiling the TeX file.
-;; - Added new user function `folding-comment-fold'. And new
-;; keybinding ";".
-;;
-;; Oct 8 1997 19.34 [Jari 2.16]
-;; - Now the minor mode map is always re-installed when this file is
-;; loaded. If user accidentally made mistake in
-;; `folding-default-keys-function', he can simply try again and
-;; reload this file to have the new key definitions.
-;; - Previously user had to manually go and delete the previous map
-;; from the `minor-mode-map-alist' before he could try again.
-;;
-;; Sep 29 1997 19.34 [Jari 2.14-2.15]
-;; - Robert Marshall <rxmarsha A T bechtel com> Sent enhancement to goto-line
-;; code. Now M-g works more intuitively.
-;; - Reformatted totally the documentation so that it can be ripped to
-;; html with jari's ema-doc.pls and t2html.pls Perl scripts.
-;; - Run through checkdoc.el 1.55 and Elint 1.10 and corrected code.
-;; - Added defcustom support. (not tested)
-;;
-;; Sep 19 1997 19.28 [Jari 2.13]
-;; - Robert Marshall <rxmarsha A T bechtel com> Sent small correction to
-;; overlay code, where the 'owner tag was set wrong.
-;;
-;; Aug 14 1997 19.28 [Jari 2.12 ]
-;; - A small regexp bug (extra whitespace was required after closing
-;; fold) cause failing of folding-convert-buffer-for-printing in the
-;; following situation
-;; - Reported by Guide. Fixed now.
-;;
-;; {{{ Main topic
-;; {{{ Subsection
-;; }}} << no space or end tag here!
-;; }}} Main topic
-;;
-;; Aug 14 1997 19.28 [Jari 2.11]
-;; - Guide Van Hoecke <Guido Van Hoecke A T bigfoot com> reported that
-;; he was using closing text for fold like:
-;;
-;; {{{ Main topic
-;; {{{ Subsection
-;; }}} Subsection
-;; }}} Main topic
-;;
-;; And when he did folding-convert-buffer-for-printing, it couldn't
-;; remove those closing marks but threw an error. I modified the
-;; function so that the regexp accepts anything after closing fold.
-;;
-;; Apr 18 1997 19.28 [Jari 2.10]
-;; - Corrected function folding-show-current-subtree, which didn't
-;; find the correct end region, because folding-pick-move needed
-;; point at the top of beginning fold. Bug was reported by Uwe
-;; Brauer <oub A T sunma4 mat ucm es> Also changed folding-mark-look-at,
-;; which now has new call parameter 'move.
-;;
-;; Mar 22 1997 19.28 [Jari 2.9]
-;; - Made the XEmacs20 match more stricter, so that
-;; folding-emacs-version gets value 'XEmacs19. Also added note about
-;; folding in WinNT in the compatibility section.
-;; - Added sh-script-mode indented-text-mode folding marks.
-;; - Moved the version from branch to the root, because the extra
-;; overlay code added, seems to be behaving well and it didn't break
-;; the existing functionality.
-;;
-;; Feb 17 1997 19.28 [Jari 2.8.1.2]
-;; - Cleaned up Dan's changes. First: we must not replace the
-;; selective display code, but offer these two choices: Added
-;; folding-use-overlays-p function which looks variable
-;; folding-allow-overlays.
-;; - Dan uses function from another Emacs specific (19.34+?) package
-;; hs-discard-overlays. This is not available in 19.28. it should
-;; be replaced with some new function... I didn't do that yet.
-;; - The overlays don't exist in XEmacs. XE19.15 has promises: at least
-;; I have heard that they have overlay.el library to mimic Emacs
-;; functions.
-;; - Now the overlay support can be turned on by setting
-;; folding-allow-overlays to non-nil. The default is to use selective
-;; display. Overlay Code is not tested!
-;;
-;; Feb 17 1997 19.28 [Dan 2.8.1.1]
-;; - Dan Nicolaescu <done A T ece arizona edu> sent patch that replaced
-;; selective display code with overlays.
-;;
-;; Feb 10 1997 19.28 [jari 2.8]
-;; - Ricardo Marek <ricky A T ornet co il> Kindly sent patch that
-;; makes code XEmacs 20.0 compatible. Thank you.
-;;
-;; Nov 7 1996 19.28 [jari 2.7]
-;; - When I was on picture-mode and turned on folding, and started
-;; isearch (I don't remember how I got fold mode on exactly) it
-;; gave error that the fold marks were not defined and emacs
-;; locked up due to simultaneous isearch-loop
-;; - Added few fixes to the isearch handling function to avoid
-;; infinite error loops.
-;;
-;; Nov 6 1996 19.28 [jari 2.5 - 2.6]
-;; - Situation: have folded buffer, manually _narrow_ somewhere, C-x n n
-;; - Then try searching --> folding breaks. Now it checks if the
-;; region is true narrow and not folding-narrow before trying
-;; to go outside of region and open a fold
-;; - If it's true narrow, then we stay in that narrowed region.
-;;
-;; folding-isearch-general :+
-;; folding-region-has-folding-marks-p :+
-;;
-;; Oct 23 1996 19.28 [jari 2.4]
-;; folding-display-name :+ new user cmd "C-n"
-;; folding-find-folding-mark :+ new
-;; folding-pick-move :! rewritten, full of bugs
-;; folding-region-open-close :! rewritten, full of bugs
-;;
-;; Oct 22 1996 19.28 [jari 2.3]
-;; - folding-pick-move :! rewritten
-;; folding-region-open-close :+ new user cmd "#"
-;; folding-show-current-subtree :+ new user cmd "C-s", hides too
-;;
-;; Aug 01 1996 19.31 [andersl]
-;; - folding-subst-regions, variable `font-lock-mode' set to nil.
-;; Thanks to <stig A T hackvan com>
-;;
-;; Jun 19 1996 19.31 [andersl]
-;; - The code has proven itself stable through the beta testing phase
-;; which has lasted the past six months.
-;; - A lot of comments written.
-;; - The package `folding-isearch' integrated.
-;; - Some code cleanup:
-;; BOLP -> folding-BOL :! renamed
-;; folding-behave-table :! field `down' removed.
-;;
-;;
-;; Mar 14 1996 19.28 [jari 1.27]
-;; - No code changes. Only some textual corrections/additions.
-;; - Section "about keymaps" added.
-;;
-;; Mar 14 1996 19.28 [jackr 1.26]
-;; - spell-check run over code.
-;;
-;; Mar 14 1996 19.28 [davidm 1.25]
-;; - David Masterson <davidm A T prism kla com> This patch makes the menubar in
-;; XEmacs work better. After I made this patch, the Hyperbole menus
-;; starting working as expected again. I believe the use of
-;; set-buffer-menubar has a problem, so the recommendation in XEmacs
-;; 19.13 is to use set-menubar-dirty-flag.
-;;
-;; Mar 13 1996 19.28 [andersl 1.24]
-;; - Corrected one minor bug in folding-check-if-folding-allowed
-;;
-;; Mar 12 1996 19.28 [jari 1.23]
-;; - Renamed all -func variables to -function.
-;;
-;; mar 12 1996 19.28 [jari 1.22]
-;; - Added new example how to change the fold marks. The automatic folding
-;; was reported to cause unnecessary delays for big files (eg. when using
-;; ediff) Now there is new function variable which can totally disable
-;; automatic folding if the return value is nil.
-;;
-;; folding-check-allow-folding-function :+ new variable
-;; folding-check-if-folding-allowed :+ new func
-;; folding-mode-find-file :! modified
-;; folding-mode-write-file :! better docs
-;; folding-goto-line :! arg "n" --> "N" due to XEmacs 19.13
-;;
-;; Mar 11 1996 19.28 [jari 1.21]
-;; - Integrated changes made by Anders' to v1.19 [folding in beta dir]
-;;
-;; Jan 25 1996 19.28 [jari 1.20]
-;; - ** Mainly cosmetic changes **
-;; - Added some 'Section' codes that can be used with lisp-mnt.el
-;; - Deleted all code in 'special section' because it was never used.
-;; - Moved some old "-v-" named variables to better names.
-;; - Removed folding-mode-flag that was never used.
-;;
-;; Jan 25 1996 19.28 [jari 1.19]
-;; - Put Anders' latest version into RCS tree.
-;;
-;; Jan 03 1996 19.30 [andersl]
-;; - `folding-mouse-call-original' uses `call-interactively'.
-;; `folding-mouse-context-sensitive' doesn't do `save-excursion'.
-;; (More changes will come later.)
-;; `folding-mouse-yank-at-p' macro corrected (quote added).
-;; Error for `epoch::version' removed.
-;; `folding-mark-look-at' Regexp change .* -> [^\n\r]* to avoid error.
-;;
-;; Nov 24 1995 19.28 [andersl]
-;; - (sequencep ) added to the code which checks for the existence
-;; of a tools menu.
-;;
-;; Aug 27 1995 19.28 19.12 [andersl]
-;; - Keybindings restructured. They now conforms with the
-;; new 19.29 styleguide. Old keybindings are still available.
-;; - Menus new goes into the "Tools" menu, if present.
-;; - `folding-mouse-open-close' renamed to
-;; `folding-mouse-context-sensitive'.
-;; - New entry `other' in `folding-behave-table' which defaults to
-;; `folding-calling-original'.
-;; - `folding-calling-original' now gets the event from `last-input-event'
-;; if called without arguments (i.e. the way `folding-act' calls it.)
-;; - XEmacs mouse support added.
-;; - `folding-mouse-call-original' can call functions with or without
-;; the Event argument.
-;; - Byte compiler generates no errors neither for Emacs 19 and XEmacs.
-;;
-;; Aug 24 1995 19.28 [jari 1.17]
-;; - To prevent infinite back calling loop, Anders suggested smart way
-;; to detect that func call chain is started only once.
-;; folding-calling-original :+ v, call chain terminator
-;; "Internal" :! v, all private vars have this string
-;; folding-mouse-call-original :! v, stricter chain check.
-;; "copyright" :! t, newer notice
-;; "commentary" :! t, ripped non-supported emacsen
-;;
-;; Aug 24 1995 19.28 [jari 1.16]
-;; ** mouse interface rewritten
-;; - Anders gave many valuable comments about simplifying the mouse usage,
-;; he suggested that every mouse function should accept standard event,
-;; and it should be called directly.
-;; folding-global :- v, not needed
-;; folding-mode-off-hook :- v, not needed
-;; folding-mouse-action-table :- v, not needed any more
-;; folding-default-keys-function :+ v, key settings
-;; folding-default-mouse-keys-function:+ v, key settings
-;; folding-mouse :- f, unnecessary
-;; 'all mouse funcs' :! f, now accept "e" parameter
-;; folding-default-keys :+ f, defines keys
-;; folding-mouse-call-original :+ f, call orig mouse func
-;; "examples" :! t, radical rewrote, only one left
-;;
-;; Aug 24 1995 19.28 [jari 1.15]
-;; - some minor changes. If we're inside a fold, Mouse-3 will go one
-;; level up if it points END or BEG marker.
-;; folding-mouse-yank-at-point:! v, added 'up 'down
-;; folding-mark-look-at :! f, more return values: '11 and 'end-in
-;; folding-open-close :! f, bug, didn't exit if inside fold
-;; PMIN, PMAX, NEXTP, add-l :+ more macros fom tinylibm.el
-;;
-;; Aug 23 1995 19.28 [andersl 1.14]
-;; - Added `eval-when-compile' around 1.13 byte-compiler fix
-;; to avoid code to be executed when using a byte-compiled version
-;; of folding.el.
-;; - Binds mode keys via `minor-mode-map-alist'
-;; (i.e. `folding-merge-keymaps' is not used in modern Emacsen.)
-;; This means that the user can not bind `folding-mode-map' to a new
-;; keymap, \\(s\\|\\)he must modify the existing one.
-;; - `defvars' for global feature test variables `folding-*-p'.
-;; - `folding-mouse-open-close' now detects when the current fold was been
-;; pressed. (The "current" is the fold around which the buffer is
-;; narrowed.)
-;;
-;; Aug 23 1995 19.28 [jari 1.13]
-;; - 19.28 Byte compile doesn't handle fboundp, boundp well. That's a bug.
-;; Set some dummy functions to get cleaner output.
-;; - The folding-mode-off doesn't seem very useful, because it
-;; is never run when another major-mode is turned on ... maybe we should
-;; utilize kill-all-local-variables-hooks with defadvice around
-;; kill-all-local-variables ...
-;;
-;; folding-emacs-version :+ added. it was in the docs, but not defined
-;; kill-all-local-variables-hooks :! v, moved to variable section
-;; list-buffers-mode-alist :! v, --''--
-;; "compiler hacks" :+ section added
-;; "special" :+ section added
-;; "Compatibility" :! moved at the beginning
-;;
-;; Aug 22 1995 19.28 [jari 1.12]
-;; - Only minor changes
-;; BOLP, BOLPP, EOLP, EOLPP :+ f, macros added from tinylibm.el
-;; folding-mouse-pick-move :! f, when cursor at beolp, move always up
-;; "bindings" :+ added C-cv and C-cC-v
-;;
-;; Aug 22 1995 19.28 [jari 1.11]
-;; - Inspired by mouse so much, that this revision contain substantial
-;; changes and enhancements. Mouse is now powered!
-;; - Anders wanted mouse to operate according to 'mouse cursor', not
-;; current 'point'.
-;; folding-mouse-yank-at-point: controls it. Phwew, I like this
-;; one a lot.
-;;
-;; examples :! t, totally changed, now 2 choices
-;; folding-mode-off-hook :+ v, when folding ends
-;; folding-global :+ v, global store value
-;; folding-mouse-action-table :! v, changed
-;; folding-mouse :! f, stores event to global
-;; folding-mouse-open-close :! f, renamed, mouse activated open
-;; folding-mode :! f, added 'off' hook
-;; folding-event-posn :+ f, handles FSF mouse event
-;; folding-mouse-yank-at-p :+ f, check which mouse mode is on
-;; folding-mouse-point :+ f, return working point
-;; folding-mouse-move :+ f, mouse moving down , obsolete ??
-;; folding-mouse-pick-move :+ f, mouse move accord. fold mark
-;; folding-next-visible-heading :+ f, from tinyfold.el
-;; folding-previous-visible-heading :+ f, from tinyfold.el
-;; folding-pick-move :+ f, from tinyfold.el
-;;
-;;
-;; Aug 22 1995 19.28 [jari 1.10]
-;; - Minor typing errors corrected : fol-open-close 'hide --> 'close
-;; This caused error when trying to close open fold with mouse
-;; when cursor was sitting on fold marker.
-;;
-;; Aug 22 1995 19.28 [jari 1.9]
-;; - Having heard good suggestions from Anders...!
-;; "install" : add-hook for folding missed
-;; folding-open-close : generalized
-;; folding-behave-table : NEW, logical behavior control
-;; folding-:mouse-action-table : now folding-mouse-action-table
-;;
-;; - The mouse function seems to work with FSF emacs only, because
-;; XEmacs doesn't know about double or triple clicks. We're working
-;; on the problem...
-;;
-;; Aug 21 1995 19.28 [jari 1.8]
-;; - Rearranged the file structure so that all variables are at the
-;; beginning of file. With new functions, it easy to open-close
-;; fold. Added word "code:" or "setup:" to the front of code folds,
-;; so that the toplevel folds can be recognized more easily.
-;; - Added example hook to install section for easy mouse use.
-;; - Added new functions.
-;; folding-get-mode-marks : return folding marks
-;; folding-mark-look-at : status of current line, fold mark in it?
-;; folding-mark-mouse : execute action on fold mark
-;;
-;;
-;; Aug 17 1995 19.28/X19.12 [andersl 1.7]
-;; - Failed when loaded into XEmacs, when `folding-mode-map' was
-;; undefined. Folding marks for three new major modes added:
-;; rexx-mode, erlang-mode and xerl-mode.
-;;
-;; Aug 14 1995 19.28 [jari 1.6]
-;; - After I met Anders we exchanged some thoughts about usage philosophy
-;; of error and signal commands. I was annoyed by the fact that they
-;; couldn't be suppressed, when the error was "minor". Later Anders
-;; developed fdb.el, which will be integrated to FSF 19.30. It
-;; offers by-passing error/signal interference.
-;; --> I changed back all the error commands that were taken away.
-;;
-;; Jun 02 1995 19.28 [andersl]
-;; - "Narrow" not present in mode-line when in folding-mode.
-;;
-;; May 12 1995 19.28 [jari 1.5]
-;; - Installation text cleaned: reference to 'install-it' removed,
-;; because such function doesn't exist any more. The installation is
-;; now automatic: it's done when user calls folding mode first time.
-;; - Added 'private vars' section. made 'outside all folds' message
-;; informational, not an error.
-;;
-;; May 12 1995 19.28 [jackr x.x]
-;; - Corrected 'broken menu bar' problem.
-;; - Even though make-sparse-keymap claims its argument (a string to
-;; name the menu) is optional, it's not. Lucid has other
-;; arrangements for the same thing..
-;;
-;; May 10 1995 19.28 [jari 1.2]
-;; - Moved provide to the end of file.
-;; - Rearranged code so that the common functions are at the beginning.
-;; Reprogrammed the whole installation with hooks. Added Write file
-;; hook that makes sure you don't write in 'binary' while folding were
-;; accidentally off.
-;; - Added regexp text for certain files which are not allowed to
-;; 'auto fold' when loaded.
-;; - changed some 'error' commands to 'messages', this prevent screen
-;; mixup when debug-on-error is set to t
-;; + folding-list-delete , folding-msg , folding-mode-find-file ,
-;; folding-mode-write-file , folding-check-folded , folding-keep-hooked
-;;
-;; 1.7.4 May 04 1995 19.28 [jackr 1.11]
-;; - Some compatibility changes:
-;; v.18 doesn't allow an arg to make-sparse-keymap
-;; testing epoch::version is trickier than that
-;; free-variable reference cleanup
-;;
-;; 1.7.3 May 04 1995 19.28 [jari]
-;; - Corrected folding-mode-find-file-hook , so that it has more
-;; 'mode turn on' capabilities through user function
-;; + folding-mode-write-file-hook: Makes sure your file is saved
-;; properly, so that you don't end up saving in 'binary'.
-;; + folding-check-folded: func, default checker provided
-;; + folding-check-folded-file-function variable added, User can put his
-;; 'detect folding.el file' methods here.
-;; + folding-mode-install-it: func, Automatic installation with it
-;;
-;; 1.7.2 Apr 01 1995 19.28 [jackr] , Design support by [jari]
-;; - Added folding to FSF & XEmacs menus
-;;
-;; 1.7.1 Apr 28 1995 19.28 [jackr]
-;; - The folding editor's merge-keymap couldn't handle FSF menu-bar,
-;; so some minor changes were made, previous is '>' and enhancements
-;; are '>'
-;;
-;; < (buffer-disable-undo new-buffer)
-;; ---
-;; > (buffer-flush-undo new-buffer)
-;; 1510,1512c1510
-;; < key (if (symbolp keycode)
-;; < (vector keycode)
-;; < (char-to-string keycode))
-;; ---
-;; > key (char-to-string keycode)
-;; 1802,1808d1799
-;; < ;;{{{ Compatibility hacks for various Emacs versions
-;; <
-;; < (or (fboundp 'buffer-disable-undo)
-;; < (fset 'buffer-disable-undo (symbol-function 'buffer-flush-undo)))
-;; <
-;; < ;;}}}
-;;
-;;
-;; X.x Dec 1 1994 19.28 [jari]
-;; - Only minor change. Made the folding mode string user configurable.
-;; Added these variables:
-;; folding-mode-string, folding-inside-string,folding-inside-mode-name
-;; - Changed revision number from 1.6.2 to 1.7 , so that people know
-;; this package has changed.
-
-;;}}}
-
-;;; Code:
-
-;;{{{ setup: require packages
-
-;;; ......................................................... &require ...
-
-(eval-when-compile
- (require 'cl))
-
-(eval-and-compile
- (autoload 'font-lock-fontify-region "font-lock")
- ;; Forward declaration
- (defvar global-font-lock-mode))
-
-(require 'easymenu)
-
-(defvar folding-package-url-location
- "Latest folding is available at http://cvs.xemacs.org/viewcvs.cgi/XEmacs/packages/xemacs-packages/text-modes/")
-
-;;}}}
-;;{{{ setup: byte compiler hacks
-
-;;; ............................................. &byte-compiler-hacks ...
-;;; - This really only should be evaluated in case we're about to byte
-;;; compile this file. Since `eval-when-compile' is evaluated when
-;;; the uncompiled version is used (great!) we test if the
-;;; byte-compiler is loaded.
-
-;; Make sure `advice' is loaded when compiling the code.
-
-(eval-and-compile
- (require 'advice)
- (defvar folding-xemacs-p (or (boundp 'xemacs-logo)
- (featurep 'xemacs))
- "Folding determines which emacs version it is running. t if Xemacs.")
- ;; loading overlay.el package removes some byte compiler whinings.
- ;; By default folding does not use overlay code.
- (if folding-xemacs-p
- (or (fboundp 'overlay-start) ;; Already loaded
- (load "overlay" 'noerr) ;; No? Try loading it.
- (message "\
-** folding.el: XEmacs 19.15+ has package overlay.el, try to get it.
- This is only warning. Folding does not use overlays by
- default. You can safely ignore possible overlay byte
- compilation error
- messages."))))
-
-(eval-when-compile
-
- (when nil ;; Disabled 2000-01-05
- ;; While byte compiling
- (if (string= (buffer-name) " *Compiler Input*")
- (progn
- (message "** folding.el:\
- Info, Ignore [X]Emacs's missing motion/event/posn functions calls"))))
-
- ;; ARGS: (symbol variable-p library)
- (defadvice find-function-search-for-symbol (around folding act)
- "Set folding flag for `find-file-noselect' to open all folds."
- (let ((file (ad-get-arg 2)))
- (when file
- (message "FILE %s" file)
- (put 'find-file-noselect 'folding file)))
- ad-do-it
- (put 'find-file-noselect 'folding nil))
-
- (defun folding-find-file-noselect ()
- (let* ((file (get 'find-file-noselect 'folding))
- (buffer (and file
- ;; It may be absolute path name, file.el,
- ;; or just "file".
- (or (find-buffer-visiting file)
- (get-buffer file)
- (get-buffer (concat file ".el"))))))
- (when buffer
- (with-current-buffer buffer
- (when (symbol-value 'folding-mode) ;; Byte compiler silencer
- (turn-off-folding-mode))))))
-
- ;; See find.func.el find-function-search-for-symbol
- ;; Make C-h f and mouse-click work to jump to a file. Folding mode
- ;; Must be turned off due to regexps in find.func.el that can't
- ;; search ^M lines.
-
- (defadvice find-file-noselect (after folding act)
- "When called by `find-function-search-for-symbol', turn folding off."
- (folding-find-file-noselect))
-
- (defadvice make-sparse-keymap
- (before
- make-sparse-keymap-with-optional-argument
- (&optional byte-compiler-happyfier)
- activate)
- "This advice does nothing except adding an optional argument
-to keep the byte compiler happy when compiling Emacs specific code
-with XEmacs.")
-
- ;; XEmacs and Emacs 19 differs when it comes to obsolete functions.
- ;; We're using the Emacs 19 versions, and this simply makes the
- ;; byte-compiler stop wining. (Why isn't there a warning flag which
- ;; could have turned off?)
-
- (and (boundp 'mode-line-format)
- (put 'mode-line-format 'byte-obsolete-variable nil))
-
- (and (fboundp 'byte-code-function-p)
- (put 'byte-code-function-p 'byte-compile nil))
-
- (and (fboundp 'eval-current-buffer)
- (put 'eval-current-buffer 'byte-compile nil)))
-
-(defsubst folding-preserve-active-region ()
- "In XEmacs keep the region alive. In Emacs do nothing."
- (if (boundp 'zmacs-region-stays) ;Keep regions alive
- (set 'zmacs-region-stays t))) ;use `set' to Quiet Emacs Byte Compiler
-
-;; Work around the NT Emacs Cut'n paste bug in selective-display which
-;; doesn't preserve C-m's. Only installed in problematic Emacs and
-;; in other cases these lines are no-op.
-
-(eval-and-compile
- (when (and (not folding-xemacs-p)
- (memq (symbol-value 'window-system) '(win32 w32)) ; NT Emacs
- (string< emacs-version "20.4")) ;at least in 19.34 .. 20.3.1
-
- (unless (fboundp 'char-equal)
- (defalias 'char-equal 'equal))
-
- (unless (fboundp 'subst-char)
- (defun subst-char (str char to-char)
- "Replace in STR every CHAR with TO-CHAR."
- (let ((len (length str))
- (ret (copy-sequence str))) ;because 'aset' is destructive
- (while (> len 0)
- (if (char-equal (aref str (1- len)) char)
- (aset ret (1- len) to-char))
- (decf len))
- ret)))
-
- (defadvice kill-new (around folding-win32-fix-selective-display act)
- "In selective display, convert each C-m to C-a. See `current-kill'."
- (let* ((string (ad-get-arg 0)))
- (when (and selective-display (string-match "\C-m" (or string "")))
- (setq string (subst-char string ?\C-m ?\C-a)))
- ad-do-it))
-
- (defadvice current-kill (around folding-win32-fix-selective-display act)
- "In selective display, convert each C-a back to C-m. See `kill-new'."
- ad-do-it
- (let* ((string ad-return-value))
- (when (and selective-display (string-match "\C-a" (or string "")))
- (setq string (subst-char string ?\C-a ?\C-m))
- (setq ad-return-value string))))))
-
-(defvar folding-mode) ;; Byte Compiler silencer
-
-(when (locate-library "mode-motion") ;; XEmacs
- (defun folding-mode-motion-highlight-fold (event)
- "Highlight line under mouse if it has a foldmark."
- (when folding-mode
- (funcall
- ;; Emacs Byte Compiler Shutup fix
- (symbol-function 'mode-motion-highlight-internal)
- event
- (function
- (lambda ()
- (beginning-of-line)
- (if (folding-mark-look-at)
- (search-forward-regexp "^[ \t]*"))))
- (function
- (lambda ()
- (if (folding-mark-look-at)
- (end-of-line)))))))
- (require 'mode-motion)
- (add-hook 'mode-motion-hook 'folding-mode-motion-highlight-fold 'at-end))
-
-;;}}}
-
-;;{{{ setup: some variable
-
-;;; .................................................. &some-variables ...
-
-;; This is a list of structures which keep track of folds being entered
-;; and exited. It is a list of (MARKER . MARKER) pairs, followed by the
-;; symbol `folded'. The first of these represents the fold containing
-;; the current one. If the view is currently outside all folds, this
-;; variable has value nil.
-
-(defvar folding-stack nil
- "Internal. A list of marker pairs representing folds entered so far.")
-
-(defvar folding-version (substring "$Revision: 3.42 $" 11 15)
- "Version number of folding.el.")
-
-;;}}}
-;;{{{ setup: bind
-
-;;; .......................................................... &v-bind ...
-
-(defgroup folding nil
- "Managing buffers with Folds."
- :group 'tools)
-
-(defcustom folding-mode-prefix-key "\C-c@"
- "*Prefix key to use for Folding commands in Folding mode."
- :type 'string
- :group 'folding)
-
-(defcustom folding-goto-key "\M-g"
- "*Key to be bound to `folding-goto-line' in folding mode.
-The default value is M - g, but you probably don't want folding to
-occupy it if you have used M - g got `goto-line'."
- :type 'string
- :group 'folding)
-
-(defcustom folding-font-lock-begin-mark 'font-lock-reference-face
- "Face to highlight beginning fold mark."
- :type 'face
- :group 'folding)
-
-(defcustom folding-font-lock-end-mark 'font-lock-reference-face
- "Face to highlight end fold mark."
- :type 'face
- :group 'folding)
-
-(defvar folding-mode-map nil
- "Keymap used in Folding mode (a minor mode).")
-
-(defvar folding-mode-prefix-map nil
- "Keymap used in Folding mode keys sans `folding-mode-prefix-key'.")
-
-;;;###autoload
-(defvar folding-mode nil
- "When Non nil, Folding mode is active in the current buffer.")
-
-(make-variable-buffer-local 'folding-mode)
-(set-default 'folding-mode nil)
-
-(defmacro folding-kbd (key function)
- "Folding: define KEY with FUNCTION to `folding-mode-prefix-map'.
-This is used when assigning keybindings to `folding-mode-map'.
-See also `folding-mode-prefix-key'."
- `(define-key
- folding-mode-prefix-map
- ,key ,function))
-
-(defun folding-bind-default-mouse ()
- "Bind default mouse keys used by Folding mode."
- (interactive)
- (cond
- (folding-xemacs-p
- (define-key folding-mode-map [(button3)]
- 'folding-mouse-context-sensitive)
- ;; (define-key folding-mode-map '(double button3) 'folding-hide-current-entry)
- (define-key folding-mode-map [(control shift button2)]
- 'folding-mouse-pick-move))
- (t
- (define-key folding-mode-map [mouse-3] 'folding-mouse-context-sensitive)
- (define-key folding-mode-map [C-S-mouse-2] 'folding-mouse-pick-move))))
-
-(defun folding-bind-terminal-keys ()
- "In non-window system, rebind C - f and C - b as folding-{forward,backward}-char."
- (unless (or (and (boundp 'window-system) ;; Emacs
- (symbol-value 'window-system)) ;; Byte compiler silencer
- (and (fboundp 'console-type) ;; XEmacs
- (let ((val (fboundp 'console-type)))
- (not (eq 'tty val)))))
- (define-key folding-mode-map "\C-f" 'folding-forward-char)
- (define-key folding-mode-map "\C-b" 'folding-backward-char)))
-
-(defun folding-bind-default-keys ()
- "Bind the default keys used the `folding-mode'.
-
-The variable `folding-mode-prefix-key' contains the prefix keys,
-the default is C - c @.
-
-For the good ol' key bindings, please use the function
-`folding-bind-backward-compatible-keys' instead."
- (interactive)
- (define-key folding-mode-map folding-goto-key 'folding-goto-line)
- (folding-bind-terminal-keys)
- (define-key folding-mode-map "\C-e" 'folding-end-of-line)
- (folding-kbd "\C-f" 'folding-fold-region)
- (folding-kbd ">" 'folding-shift-in)
- (folding-kbd "<" 'folding-shift-out)
- (folding-kbd "\C-t" 'folding-show-all)
- (folding-kbd "\C-s" 'folding-show-current-entry)
- (folding-kbd "\C-x" 'folding-hide-current-entry)
- (folding-kbd "\C-o" 'folding-open-buffer)
- (folding-kbd "\C-w" 'folding-whole-buffer)
- (folding-kbd "\C-r" 'folding-convert-buffer-for-printing)
- (folding-kbd "\C-k" 'folding-marks-kill)
- (folding-kbd "\C-v" 'folding-pick-move)
- (folding-kbd "v" 'folding-previous-visible-heading)
- (folding-kbd " " 'folding-next-visible-heading)
- (folding-kbd "." 'folding-context-next-action)
- ;; C-u: kinda "up" -- "down"
- (folding-kbd "\C-u" 'folding-toggle-enter-exit)
- (folding-kbd "\C-q" 'folding-toggle-show-hide)
- ;; Think "#" as a 'fence'
- (folding-kbd "#" 'folding-region-open-close)
- ;; Esc-; is the standard emacs commend add key.
- (folding-kbd ";" 'folding-comment-fold)
- (folding-kbd "%" 'folding-convert-to-major-folds)
- (folding-kbd "/" 'folding-all-comment-blocks-in-region)
- (folding-kbd "\C-y" 'folding-show-current-subtree)
- (folding-kbd "\C-z" 'folding-hide-current-subtree)
- (folding-kbd "\C-n" 'folding-display-name)
- (folding-kbd "I" 'folding-insert-advertise-folding-mode))
-
-(defun folding-bind-backward-compatible-keys ()
- "Bind keys traditionally used by Folding mode.
-For bindings which follow newer Emacs minor mode conventions, please
-use the function `folding-bind-default-keys'.
-
-This function sets `folding-mode-prefix-key' to `C-c'."
- (interactive)
- (setq folding-mode-prefix-key "\C-c")
- (folding-bind-default-keys))
-
-(defun folding-bind-outline-compatible-keys ()
- "Bind keys used by the minor mode `folding-mode'.
-The keys used are as much as possible compatible with
-bindings used by Outline mode.
-
-Currently, some outline mode functions doesn't have a corresponding
-folding function.
-
-The variable `folding-mode-prefix-key' contains the prefix keys,
-the default is C - c @.
-
-For the good ol' key bindings, please use the function
-`folding-bind-backward-compatible-keys' instead."
- (interactive)
- ;; Traditional keys:
- (folding-bind-terminal-keys)
- (define-key folding-mode-map "\C-e" 'folding-end-of-line)
- ;; Mimic Emacs 20.3 allout.el bindings
- (folding-kbd ">" 'folding-shift-in)
- (folding-kbd "<" 'folding-shift-out)
- (folding-kbd "\C-n" 'folding-next-visible-heading)
- (folding-kbd "\C-p" 'folding-previous-visible-heading)
- ;; ("\C-u" outline-up-current-level)
- ;; ("\C-f" outline-forward-current-level)
- ;; ("\C-b" outline-backward-current-level)
- ;; (folding-kbd "\C-i" 'folding-show-current-subtree)
- (folding-kbd "\C-s" 'folding-show-current-subtree)
- (folding-kbd "\C-h" 'folding-hide-current-subtree)
- (folding-kbd "\C-k" 'folding-marks-kill)
- (folding-kbd "!" 'folding-show-all)
- (folding-kbd "\C-d" 'folding-hide-current-entry)
- (folding-kbd "\C-o" 'folding-show-current-entry)
- ;; (" " outline-open-sibtopic)
- ;; ("." outline-open-subtopic)
- ;; ("," outline-open-supertopic)
- ;; Other bindings not in allout.el
- (folding-kbd "\C-a" 'folding-open-buffer)
- (folding-kbd "\C-q" 'folding-whole-buffer)
- (folding-kbd "\C-r" 'folding-convert-buffer-for-printing)
- (folding-kbd "\C-w" 'folding-fold-region)
- (folding-kbd "I" 'folding-insert-advertise-folding-mode))
-
-;;{{{ goto-line (advice)
-
-(defcustom folding-advice-instantiate t
- "*In non-nil install advice code. Eg for `goto-line'."
- :type 'boolean
- :group 'folding)
-
-(defcustom folding-shift-in-on-goto t
- "*Flag in folding adviced function `goto-line'.
-If non-nil, folds are entered when going to a given line.
-Otherwise the buffer is unfolded. Can also be set to 'show.
-This variable is used only if `folding-advice-instantiate' was
-non-nil when folding was loaded.
-
-See also `folding-goto-key'."
- :type 'boolean
- :group 'folding)
-
-(defvar folding-narrow-by-default t
- "If t (default) things like isearch will enter folds. If nil the
-folds will be opened, but not entered.")
-
-(when folding-advice-instantiate
- (eval-when-compile (require 'advice))
- ;; By Robert Marshall <rxmarsha A T bechtel com>
- (defadvice goto-line (around folding-goto-line first activate)
- "Go to line ARG, entering folds if `folding-shift-in-on-goto' is t.
-It attempts to keep the buffer in the same visibility state as before."
- (let () ;; (oldposn (point))
- ad-do-it
- (if (and folding-mode
- (or (folding-point-folded-p (point))
- (<= (point) (point-min-marker))
- (>= (point) (point-max-marker))))
- (let ((line (ad-get-arg 0)))
- (if folding-shift-in-on-goto
- (progn
- (folding-show-all)
- (goto-char 1)
- (and (< 1 line)
- (not (folding-use-overlays-p))
- (re-search-forward "[\n\C-m]" nil 0 (1- line)))
- (let ((goal (point)))
- (while (prog2 (beginning-of-line)
- (if (eq folding-shift-in-on-goto 'show)
- (progn
- (folding-show-current-entry t t)
- (folding-point-folded-p goal))
- (folding-shift-in t))
- (goto-char goal)))
- (folding-narrow-to-region
- (and folding-narrow-by-default (point-min))
- (point-max) t)))
- (if (or folding-stack (folding-point-folded-p (point)))
- (folding-open-buffer))))))))
-
-;;}}}
-
-(defun folding-bind-foldout-compatible-keys ()
- "Bind keys for `folding-mode' compatible with Foldout mode.
-
-The variable `folding-mode-prefix-key' contains the prefix keys,
-the default is C - c @."
- (interactive)
- (folding-kbd "\C-z" 'folding-shift-in)
- (folding-kbd "\C-x" 'folding-shift-out))
-
-;;; This function is here, just in case we ever would like to add
-;;; `hideif' support to folding mode. Currently, it is only used to
-;;; which keys shouldn't be used.
-
-;;(defun folding-bind-hideif-compatible-keys ()
-;; "Bind keys for `folding-mode' compatible with Hideif mode.
-;;
-;;The variable `folding-mode-prefix-key' contains the prefix keys,
-;;the default is C-c@."
-;; (interactive)
-;; ;; Keys defined by `hideif'
-;; ;; (folding-kbd "d" 'hide-ifdef-define)
-;; ;; (folding-kbd "u" 'hide-ifdef-undef)
-;; ;; (folding-kbd "D" 'hide-ifdef-set-define-alist)
-;; ;; (folding-kbd "U" 'hide-ifdef-use-define-alist)
-;;
-;; ;; (folding-kbd "h") 'hide-ifdefs)
-;; ;; (folding-kbd "s") 'show-ifdefs)
-;; ;; (folding-kbd "\C-d") 'hide-ifdef-block)
-;; ;; (folding-kbd "\C-s") 'show-ifdef-block)
-;;
-;; ;; (folding-kbd "\C-q" 'hide-ifdef-toggle-read-only)
-;; )
-
-;;; .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .
-
-;; Not used for modern Emacsen.
-(defvar folding-saved-local-keymap nil
- "Keymap used to save non-folding keymap.
-(so it can be restored when folding mode is turned off.)")
-
-;;;###autoload
-(defcustom folding-default-keys-function 'folding-bind-default-keys
- "*Function or list of functions used to define keys for Folding mode.
-Possible values are:
- folding-bind-default-key
- The standard keymap.
-
- `folding-bind-backward-compatible-keys'
- Keys used by older versions of Folding mode. This function
- does not conform to Emacs 19.29 style conversions concerning
- key bindings. The prefix key is C - c
-
- `folding-bind-outline-compatible-keys'
- Define keys compatible with Outline mode.
-
- `folding-bind-foldout-compatible-keys'
- Define some extra keys compatible with Foldout.
-
-All except `folding-bind-backward-compatible-keys' used the value of
-the variable `folding-mode-prefix-key' as prefix the key.
-The default is C - c @"
- :type 'function
- :group 'folding)
-
-;; Not yet implemented:
-;; folding-bind-hideif-compatible-keys
-;; Define some extra keys compatible with hideif.
-
-;;;###autoload
-(defcustom folding-default-mouse-keys-function 'folding-bind-default-mouse
- "*Function to bind default mouse keys to `folding-mode-map'."
- :type 'function
- :group 'folding)
-
-(defvar folding-mode-menu nil
- "Keymap containing the menu for Folding mode.")
-
-(defvar folding-mode-menu-name "Fld" ;; Short menu name
- "Name of pull down menu.")
-
-;;}}}
-;;{{{ setup: hooks
-
-;;; ......................................................... &v-hooks ...
-
-(defcustom folding-mode-hook nil
- "*Hook called when Folding mode is entered.
-
-A hook named `<major-mode>-folding-hook' is also called, if it
-exists. Eg., `c-mode-folding-hook' is called whenever Folding mode is
-started in C mode."
- :type 'hook
- :group 'folding)
-
-(defcustom folding-load-hook nil
- "*Hook run when file is loaded."
- :type 'hook
- :group 'folding)
-
-;;}}}
-;;{{{ setup: user config
-
-;;; ........................................................ &v-Config ...
-
-;; Q: should this inherit mouse-yank-at-point's value? maybe not.
-(defvar folding-mouse-yank-at-point t
- "If non-nil, mouse activities are done at point instead of 'mouse cursor'.
-Behaves like `mouse-yank-at-point'.")
-
-(defcustom folding-folding-on-startup t
- "*If non-nil, buffers are folded when starting Folding mode."
- :type 'boolean
- :group 'folding)
-
-(defcustom folding-internal-margins 1
- "*Number of blank lines left next to fold mark when tidying folds.
-
-This variable is local to each buffer. To set the default value for all
-buffers, use `set-default'.
-
-When exiting a fold, and at other times, `folding-tidy-inside' is invoked
-to ensure that the fold is in the correct form before leaving it. This
-variable specifies the number of blank lines to leave between the
-enclosing fold marks and the enclosed text.
-
-If this value is nil or negative, no blank lines are added or removed
-inside the fold marks. A value of 0 (zero) is valid, meaning leave no
-blank lines.
-
-See also `folding-tidy-inside'."
- :type 'boolean
- :group 'folding)
-
-(make-variable-buffer-local 'folding-internal-margins)
-
-(defvar folding-mode-string " Fld"
- "Buffer-local variable that hold the fold depth description.")
-
-(set-default 'folding-mode-string " Fld")
-
-;; Sets `folding-mode-string' appropriately. This allows the Folding mode
-;; description in the mode line to reflect the current fold depth.
-
-(defconst folding-inside-string " " ; was ' inside ',
- "Mode line addition to show 'inside' levels of fold.")
-
-;;;###autoload
-(defcustom folding-inside-mode-name "Fld"
- "*Mode line addition to show inside levels of 'fold' ."
- :type 'string
- :group 'folding)
-
-(defcustom folding-check-folded-file-function
- 'folding-check-folded
- "*Function that return t or nil after examining if the file is folded."
- :type 'function
- :group 'folding)
-
-(defcustom folding-check-allow-folding-function
- 'folding-check-if-folding-allowed
- "*Function that return t or nil after deciding if automatic folding."
- :type 'function
- :group 'folding)
-
-;;;###autoload
-(defcustom folding-mode-string "Fld"
- "*The minor mode string displayed when mode is on."
- :type 'string
- :group 'folding)
-
-;;;###autoload
-(defcustom folding-mode-hook-no-regexp "RMAIL"
- "*Regexp which disable automatic folding mode turn on for certain files."
- :type 'string
- :group 'folding)
-
-;;; ... ... ... ... ... ... ... ... ... ... ... ... ... .... &v-tables ...
-
-(defcustom folding-behave-table
- '((close folding-hide-current-entry)
- (open folding-show-current-entry) ; Could also be `folding-shift-in'.
- (up folding-shift-out)
- (other folding-mouse-call-original))
- "*Table of of logical commands and their associated functions.
-If you want fold to behave like `folding-shift-in', when it 'open'
-a fold, you just change the function entry in this table.
-
-Table form:
- '( (LOGICAL-ACTION CMD) (..) ..)"
- :type '(repeat
- (symbol :tag "logical action")
- (function :tag "callback"))
- :group 'folding)
-
-;;; ... ... ... ... ... ... ... ... ... ... ... ... ... ..... &v-marks ...
-
-;;;###autoload
-(defvar folding-mode-marks-alist nil
- "List of (major-mode . fold mark) default combinations to use.
-When Folding mode is started, the major mode is checked, and if there
-are fold marks for that major mode stored in `folding-mode-marks-alist',
-those marks are used by default. If none are found, the default values
-of \"{{{ \" and \"}}}\" are used.
-
-Use function `folding-add-to-marks-list' to add more fold marks. The function
-also explains the alist use in details.
-
-Use function `folding-set-local-variables' if you change the current mode's
-folding marks during the session.")
-
-;;}}}
-;;{{{ setup: private
-
-;;; ....................................................... &v-private ...
-
-(defvar folding-narrow-placeholder nil
- "Internal. Mark where \"%n\" used to be in `mode-line-format'.
-Must be nil.")
-
-(defvar folding-bottom-mark nil
- "Internal marker of the true bottom of a fold.")
-
-(defvar folding-bottom-regexp nil
- "Internal. Regexp marking the bottom of a fold.")
-
-(defvar folding-regexp nil
- "Internal. Regexp for hunting down the `folding-top-mark' even in comments.")
-
-(defvar folding-secondary-top-mark nil
- "Internal. Additional stuff that can be inserted as part of a top marker.")
-
-(defvar folding-top-mark nil
- "Internal. The actual string marking the top of a fold.")
-
-(defvar folding-top-regexp nil
- "Internal.
-Regexp describing the string beginning a fold, possible with
-leading comment thingies and like that.")
-
-(defvar folded-file nil
- "Enter folding mode when this file is loaded.
-(buffer local, use from a local variables list).")
-
-(defvar folding-calling-original nil
- "Internal. Non-nil when original mouse binding is executed.")
-
-(defvar folding-narrow-overlays nil
- "Internal. Keep the list of overlays.")
-(make-variable-buffer-local 'folding-narrow-overlays)
-
-(defcustom folding-allow-overlays nil
- "*If non-nil use overlay code. If nil, then selective display is used.
-Note, that this code is highly experimental and will not most likely do what
-you expect. using value t will not change folding to use overlays
-completely. This variable was introduced to experiment with the overlay
-interface, but the work never finished and it is unlikely that it
-will continued any later time. Folding at present state is designed
-too highly for selective display to make the change worthwhile."
- :type 'boolean
- :group 'folding)
-
-;;}}}
-;;{{{ Folding install
-
-(defun folding-easy-menu-define ()
- "Define folding easy menu."
- (interactive)
- (easy-menu-define
- folding-mode-menu
- (if folding-xemacs-p
- nil
- (list folding-mode-map))
- "Folding menu"
- (list
- folding-mode-menu-name
- ["Enter Fold" folding-shift-in t]
- ["Exit Fold" folding-shift-out t]
- ["Show Fold" folding-show-current-entry t]
- ["Hide Fold" folding-hide-current-entry t]
- "----"
- ["Show Whole Buffer" folding-open-buffer t]
- ["Fold Whole Buffer" folding-whole-buffer t]
- ["Show subtree" folding-show-current-subtree t]
- ["Hide subtree" folding-hide-current-subtree t]
- ["Display fold name" folding-display-name t]
- "----"
- ["Move previous" folding-previous-visible-heading t]
- ["Move next" folding-next-visible-heading t]
- ["Pick fold" folding-pick-move t]
- ["Next action (context)" folding-context-next-action t]
- "----"
- ["Foldify region" folding-fold-region t]
- ["Open or close folds in region" folding-region-open-close t]
- ["Open folds to top level" folding-show-all t]
- "----"
- ["Comment text in fold" folding-comment-fold t]
- ["Convert for printing(temp buffer)"
- folding-convert-buffer-for-printing t]
- ["Convert to major-mode folds" folding-convert-to-major-folds t]
- ["Move comments inside folds in region"
- folding-all-comment-blocks-in-region t]
- ["Delete fold marks in this fold" folding-marks-kill t]
- ["Insert folding URL reference"
- folding-insert-advertise-folding-mode t]
- "----"
- ["Toggle enter and exit mode" folding-toggle-enter-exit t]
- ["Toggle show and hide" folding-toggle-show-hide t]
- "----"
- ["Folding mode off" folding-mode t])))
-
-(defun folding-install-keymaps ()
- "Install keymaps."
- (unless folding-mode-map
- (setq folding-mode-map (make-sparse-keymap)))
- (unless folding-mode-prefix-map
- (setq folding-mode-prefix-map (make-sparse-keymap)))
- (if (listp folding-default-keys-function)
- (mapc 'funcall folding-default-keys-function)
- (funcall folding-default-keys-function))
- (funcall folding-default-mouse-keys-function)
- (folding-easy-menu-define)
- (define-key folding-mode-map
- folding-mode-prefix-key folding-mode-prefix-map)
- ;; Install the keymap into `minor-mode-map-alist'. The keymap will
- ;; be activated as soon as the variable `folding-mode' is set to
- ;; non-nil.
- (let ((elt (assq 'folding-mode minor-mode-map-alist)))
- ;; Always remove old map before adding new definitions.
- (if elt
- (setq minor-mode-map-alist
- (delete elt minor-mode-map-alist)))
- (push (cons 'folding-mode folding-mode-map) minor-mode-map-alist))
- ;; Update minor-mode-alist
- (or (assq 'folding-mode minor-mode-alist)
- (push '(folding-mode folding-mode-string) minor-mode-alist))
- ;; Needed for XEmacs
- (or (fboundp 'buffer-disable-undo)
- (fset 'buffer-disable-undo (symbol-function 'buffer-flush-undo))))
-
-(defun folding-uninstall-keymaps ()
- "Uninstall keymaps."
- (let ((elt (assq 'folding-mode minor-mode-map-alist)))
- (if elt
- (setq minor-mode-map-alist
- (delete elt minor-mode-map-alist)))
- (if (setq elt (assq 'folding-mode minor-mode-alist))
- (setq minor-mode-alist
- (delete elt minor-mode-alist)))
- (folding-uninstall-hooks)))
-
-(defun folding-install (&optional uninstall)
- "Install or UNINSTALL folding."
- (interactive "P")
- (cond
- (uninstall
- (folding-uninstall-keymaps)
- (folding-uninstall-hooks))
- (t
- (folding-install-keymaps))))
-
-(defun folding-uninstall ()
- "Uninstall folding."
- (interactive)
- (folding-install 'uninstall)
- ;; Unwrap all buffers.
- (dolist (buffer (buffer-list))
- (with-current-buffer buffer
- (goto-char (point-min))
- (when (or folding-mode
- ;; To be sure, check this at the same time
- ;; Somebody may have just done
- ;; (setq folding-mode nil), which is bad thing.
- ;; Setting variable won't restore the buffer.
- (re-search-forward "{{{" nil t))
- (turn-off-folding-mode)))))
-
-;;}}}
-;;{{{ code: misc
-
-(defsubst folding-get-mode-marks (&optional mode)
- "Return fold markers for MODE. default is for current `major-mode'.
-
-Return:
- \(beg-marker end-marker\)"
- (interactive)
- (let* (elt)
- (unless (setq elt (assq (or mode major-mode)
- folding-mode-marks-alist))
- (error "Folding error: mode is not in `folding-mode-marks-alist'"))
- (list (nth 1 elt) (nth 2 elt) (nth 3 elt))))
-
-(defun folding-region-has-folding-marks-p (beg end)
- "Check is there is fold mark in region BEG END."
- (save-excursion
- (goto-char beg)
- (when (memq (folding-mark-look-at) '(1 11))
- (goto-char end)
- (memq (folding-mark-look-at) '(end end-in)))))
-
-;;; - Thumb rule: because "{{{" if more meaningful, all returns values
-;;; are of type integerp if it is found.
-;;;
-(defun folding-mark-look-at (&optional mode)
- "Check status of current line. Does it contain a fold mark?.
-
-MODE
-
- 'move move over fold mark
-
-Return:
-
- 0 1 numberp, line has fold begin mark
- 0 = closed, 1 = open,
- 11 = open, we're inside fold, and this is top marker
-
- 'end end mark
-
- 'end-in end mark, inside fold, floor marker
-
- nil no fold marks .."
- (let* (case-fold-search
- (marks (folding-get-mode-marks))
- (stack folding-stack)
- (bm (regexp-quote (nth 0 marks))) ;begin mark
- (em (concat "^[ \t\n]*" (regexp-quote (nth 1 marks))))
- (bm-re (concat
- (concat "^[ \t\n]*" bm)
- (if (and nil
- (string=
- " " (substring (nth 0 marks)
- (length (nth 1 marks)))))
- ;; Like "}}} *"
- "*"
- "")))
- ret
- point)
- (save-excursion
- (beginning-of-line)
- (cond
- ((looking-at bm-re)
- (setq point (point))
- (cond
- ((looking-at (concat "^[ \t\n]*" bm "[^\r\n]*\r")) ;; closed
- (setq ret 0))
- (t ;; open fold marker
- (goto-char (point-min))
- (cond
- ((and stack ;; we're inside fold
- ;; allow spaces
- (looking-at (concat "[ \t\n]*" bm)))
- (setq ret 11))
- (t
- (setq ret 1))))))
- ((looking-at em)
- (setq point (point))
- ;; - The stack is a list if we've entered inside fold. There
- ;; is no text after fold END mark
- ;; - At bol ".*\n[^\n]*" doesn't work but "\n[^\n]*" at eol does??
- (cond
- ((progn
- (end-of-line)
- (or (and stack (eobp)) ;normal ending
- (and stack ;empty newlines only, no text ?
- (not (looking-at "\n[^ \t\n]*")))))
- (setq ret 'end-in))
- (t ;all rest are newlines
- (setq ret 'end))))))
- (cond
- ((and mode point)
- (goto-char point)
- ;; This call breaks if there is no marks on the point,
- ;; because there is no parameter 'nil t' in call.
- ;; --> there is error in this function if that happens.
- (beginning-of-line)
- (re-search-forward (concat bm "\\|" em))
- (backward-char 1)))
- ret))
-
-(defsubst folding-mark-look-at-top-mark-p ()
- "Check if line contain folding top marker."
- (integerp (folding-mark-look-at)))
-
-(defsubst folding-mark-look-at-bottom-mark-p ()
- "Check if line contain folding bottom marker."
- (symbolp (folding-mark-look-at)))
-
-(defun folding-act (action &optional event)
- "Execute logical ACTION based on EVENT.
-
-References:
- `folding-behave-table'"
- (let* ((elt (assoc action folding-behave-table)))
- (if elt
- (funcall (nth 1 elt) event)
- (error "Folding mode (folding-act): Unknown action %s" action))))
-
-(defun folding-region-open-close (beg end &optional close)
- "Open all folds inside region BEG END. Close if optional CLOSE is non-nil."
- (interactive "r\nP")
- (let* ((func (if (null close)
- 'folding-show-current-entry
- 'folding-hide-current-entry))
- tmp)
- (save-excursion
- ;; make sure the beg is first.
- (if (> beg end) ;swap order
- (setq tmp beg beg end end tmp))
- (goto-char beg)
- (while (and
- ;; the folding-show-current-entry/hide will move point
- ;; to beg-of-line So we must move to the end of
- ;; line to continue search.
- (if (and close
- (eq 0 (folding-mark-look-at))) ;already closed ?
- t
- (funcall func)
- (end-of-line)
- t)
- (folding-next-visible-heading)
- (< (point) end))))))
-
-(defun fold-marks-kill ()
- "If over fold, open fold and kill beginning and end fold marker.
-Return t ot nil if marks were removed."
- (interactive)
- (if (not (folding-mark-look-at))
- (when (interactive-p)
- (message "Folding: Cursor not over fold. Can't remove fold marks.")
- nil)
- (destructuring-bind (beg end)
- (folding-show-current-entry)
- (let ((kill-whole-line t))
- ;; must be done in this order, because point moves after kill.
- (goto-char end)
- (beginning-of-line)
- (kill-line)
- (goto-char beg)
- (beginning-of-line)
- (kill-line)
- ;; Return status
- t))))
-
-(defun folding-hide-current-subtree ()
- "Call `folding-show-current-subtree' with argument 'hide."
- (interactive)
- (folding-show-current-subtree 'hide))
-
-(defun folding-show-current-subtree (&optional hide)
- "Show or HIDE all folds inside current fold.
-Point must be over beginning fold mark."
- (interactive "P")
- (let* ((stat (folding-mark-look-at 'move))
- (beg (point))
- end)
- (cond
- ((memq stat '(0 1 11)) ;It's BEG fold
- (when (eq 0 stat) ;it was closed
- (folding-show-current-entry)
- (goto-char beg)) ;folding-pick-move needs point at fold
- (save-excursion
- (if (folding-pick-move)
- (setq end (point))))
- (if (and beg end)
- (folding-region-open-close beg end hide)))
- (t
- (if (interactive-p)
- (message "point is not at fold beginning."))))))
-
-(defun folding-display-name ()
- "Show current active fold name."
- (interactive)
- (let* ((pos (folding-find-folding-mark))
- name)
- (when pos
- (save-excursion
- (goto-char pos)
- (if (looking-at ".*[{]+") ;Drop "{" mark away.
- (setq pos (match-end 0)))
- (setq name (buffer-substring
- pos
- (progn
- (end-of-line)
- (point))))))
- (if name
- (message (format "fold:%s" name)))))
-
-;;}}}
-;;{{{ code: events
-
-(defun folding-event-posn (act event)
- "According to ACT read mouse EVENT struct and return data from it.
-Event must be simple click, no dragging.
-
-ACT
- 'mouse-point return the 'mouse cursor' point
- 'window return window pointer
- 'col-row return list (col row)"
- (cond
- ((not folding-xemacs-p)
- ;; short Description of FSF mouse event
- ;;
- ;; EVENT : (mouse-3 (#<window 34 on *scratch*> 128 (20 . 104) -23723628))
- ;; event-start : (#<window 34 on *scratch*> 128 (20 . 104) -23723628))
- ;; ^^^MP
- ;; mp = mouse point
- (let* ((el (funcall (symbol-function 'event-start) event)))
- (cond
- ((eq act 'mouse-point)
- (nth 1 el)) ;is there macro for this ?
- ((eq act 'window)
- (funcall (symbol-function 'posn-window) el))
- ((eq act 'col-row)
- (funcall (symbol-function 'posn-col-row) el))
- (t
- (error "Unknown request %s" act)))))
- (folding-xemacs-p
- (cond
- ((eq act 'mouse-point)
- (funcall (symbol-function 'event-point) event))
- ((eq act 'window)
- (funcall (symbol-function 'event-window) event))
- ;; Must be tested! (However, it's not used...)
- ((eq act 'col-row)
- (list (funcall (symbol-function 'event-x) event)
- (funcall (symbol-function 'event-y) event)))
- (t
- (error "Unknown request %s" act))))
- (t
- (error "This version of Emacs can't handle events."))))
-
-(defmacro folding-interactive-spec-p ()
- "Preserve region during `interactive'.
-In XEmacs user could also set `zmacs-region-stays'."
- (if folding-xemacs-p
- ;; preserve selected region
- `'(interactive "_p")
- `'(interactive "p")))
-
-(defmacro folding-mouse-yank-at-p ()
- "Check if user use \"yank at mouse point\" feature.
-
-Please see the variable `folding-mouse-yank-at-point'."
- 'folding-mouse-yank-at-point)
-
-(defun folding-mouse-point (&optional event)
- "Return mouse's working point. Optional EVENT is mouse click.
-When used on XEmacs, return nil if no character was under the mouse."
- (if (or (folding-mouse-yank-at-p)
- (null event))
- (point)
- (folding-event-posn 'mouse-point event)))
-
-;;}}}
-
-;;{{{ code: hook
-
-(defmacro folding-find-file-hook ()
- "Return hook symbol for current version."
- `(if (boundp 'find-file-hook)
- 'find-file-hook
- 'find-file-hooks))
-
-(defmacro folding-write-file-hook ()
- "Return hook symbol for current version."
- `(if (boundp 'write-file-functions)
- 'write-file-functions
- 'write-file-hooks))
-
-(defun folding-is-hooked ()
- "Check if folding hooks are installed."
- (and (memq 'folding-mode-write-file
- (symbol-value (folding-write-file-hook)))
- (memq 'folding-mode-find-file
- (symbol-value (folding-find-file-hook)))))
-
-;;;###autoload
-(defun folding-uninstall-hooks ()
- "Remove hooks set by folding."
- (turn-off-folding-mode)
- (remove-hook 'finder-mode-hook 'folding-mode)
- (remove-hook 'write-file-hooks 'folding-mode-write-file)
- (remove-hook 'find-file-hooks 'folding-mode-find-file))
-
-;;;###autoload
-(defun folding-install-hooks ()
- "Install folding hooks."
- (folding-mode-add-find-file-hook)
- (add-hook 'finder-mode-hook 'folding-mode)
- (or (memq 'folding-mode-write-file (symbol-value (folding-write-file-hook)))
- (add-hook (folding-write-file-hook) 'folding-mode-write-file 'end)))
-
-;;;###autoload
-(defun folding-keep-hooked ()
- "Make sure hooks are in their places."
- (unless (folding-is-hooked)
- (folding-uninstall-hooks)
- (folding-install-hooks)))
-
-;;}}}
-;;{{{ code: Mouse handling
-
-(defun folding-mouse-call-original (&optional event)
- "Execute original mouse function using mouse EVENT.
-
-Do nothing if original function does not exist.
-
-Does nothing when called by a function which has earlier been called
-by us.
-
-Sets global:
- `folding-calling-original'"
- (interactive "@e") ;; Was "e"
- ;; Without the following test we could easily end up in a endless
- ;; loop in case we would call a function which would call us.
- ;;
- ;; (An easy constructed example is to bind the function
- ;; `folding-mouse-context-sensitive' to the same mouse button both in
- ;; `folding-mode-map' and in the global map.)
- (if folding-calling-original
- nil
- ;; `folding-calling-original' is global
- (setq folding-calling-original t)
- (unwind-protect
- (progn
- (or event
- (setq event last-input-event))
- (let (mouse-key)
- (cond
- ((not folding-xemacs-p)
- (setq mouse-key (make-vector 1 (car-safe event))))
- (folding-xemacs-p
- (setq mouse-key
- (vector
- (append
- (event-modifiers event)
- (list (intern
- (format "button%d"
- (funcall
- (symbol-function 'event-button)
- event))))))))
- (t
- (error "This version of Emacs can't handle events.")))
- ;; Test string: http://www.csd.uu.se/~andersl
- ;; andersl A T csd uu se
- ;; (I have `ark-goto-url' bound to the same key as
- ;; this function.)
- ;;
- ;; turn off folding, so that we can see the real
- ;; function behind it.
- ;;
- ;; We have to restore the current buffer, otherwise the
- ;; let* won't be able to restore the old value of
- ;; folding-mode. In my environment, I have bound a
- ;; function which starts mail when I click on an e-mail
- ;; address. When returning, the current buffer has
- ;; changed.
- (let* ((folding-mode nil)
- (orig-buf (current-buffer))
- (orig-func (key-binding mouse-key)))
- ;; call only if exist
- (when orig-func
- ;; Check if the original function has arguments. If
- ;; it does, call it with the event as argument.
- (unwind-protect
- (progn
- (setq this-command orig-func)
- (call-interactively orig-func))
-;;; #untested, but included here for further reference
-;;; (cond
-;;; ((not (string-match "mouse" (symbol-name orig-func)))
-;;; (call-interactively orig-func))
-;;; ((string-match "^mouse" (symbol-name orig-func))
-;;; (funcall orig-func event))
-;;; (t
-;;; ;; Some other package's mouse command,
-;;; ;; should we do something special here for
-;;; ;; somebody?
-;;; (funcall orig-func event)))
- (set-buffer orig-buf))))))
- ;; This is always executed, even if the above generates an error.
- (setq folding-calling-original nil))))
-
-(defun folding-mouse-context-sensitive (event)
- "Perform some operation depending on the context of the mouse pointer.
-EVENT is mouse event.
-
-The variable `folding-behave-table' contains a mapping between contexts and
-operations to perform.
-
-The following contexts can be handled (They are named after the
-natural operation to perform on them):
-
- open - A folded fold.
- close - An open fold, which isn't the one current topmost one.
- up - The topmost visible fold.
- other - Anything else.
-
-Note that the `pointer' can be either the buffer point, or the mouse
-pointer depending in the setting of the user option
-`folding-mouse-yank-at-point'."
- (interactive "e")
- (let* ( ;; - Get mouse cursor point, or point
- (point (folding-mouse-point event))
- state)
- (if (null point)
- ;; The user didn't click on any text.
- (folding-act 'other event)
- (save-excursion
- (goto-char point)
- (setq state (folding-mark-look-at)))
- (cond
- ((eq state 0)
- (folding-act 'open event))
- ((eq state 1)
- (folding-act 'close event))
- ((eq state 11)
- (folding-act 'up event))
- ((eq 'end state)
- (folding-act 'close))
- ((eq state 'end-in)
- (folding-act 'up event))
- (t
- (folding-act 'other event))))))
-
-;;; FIXME: #not used, the pick move handles this too
-(defun folding-mouse-move (event)
- "Move down if sitting on fold mark using mouse EVENT.
-
-Original function behind the mouse is called if no FOLD action wasn't
-taken."
- (interactive "e")
- (let* ( ;; - Get mouse cursor point, or point
- (point (folding-mouse-point event))
- state)
- (save-excursion
- (goto-char point)
- (beginning-of-line)
- (setq state (folding-mark-look-at)))
- (cond
- ((not (null state))
- (goto-char point)
- (folding-next-visible-heading) t)
- (t
- (folding-mouse-call-original event)))))
-
-(defun folding-mouse-pick-move (event)
- "Pick movement if sitting on beg/end fold mark using mouse EVENT.
-If mouse if at the `beginning-of-line' point, then always move up.
-
-Original function behind the mouse is called if no FOLD action wasn't
-taken."
- (interactive "e")
- (let* ( ;; - Get mouse cursor point, or point
- (point (folding-mouse-point event))
- state)
- (save-excursion
- (goto-char point)
- (setq state (folding-mark-look-at)))
- (cond
- ((not (null state))
- (goto-char point)
- (if (= point
- (save-excursion (beginning-of-line) (point)))
- (folding-previous-visible-heading)
- (folding-pick-move)))
- (t
- (folding-mouse-call-original event)))))
-
-;;}}}
-;;{{{ code: engine
-
-(defun folding-set-mode-line ()
- "Update modeline with fold level."
- (if (null folding-stack)
- (kill-local-variable 'folding-mode-string)
- (make-local-variable 'folding-mode-string)
- (setq folding-mode-string
- (if (eq 'folded (car folding-stack))
- (concat
- folding-inside-string "1" folding-inside-mode-name)
- (concat
- folding-inside-string
- (int-to-string (length folding-stack))
- folding-inside-mode-name)))))
-
-(defun folding-clear-stack ()
- "Clear the fold stack, and release all the markers it refers to."
- (let ((stack folding-stack))
- (setq folding-stack nil)
- (while (and stack (not (eq 'folded (car stack))))
- (set-marker (car (car stack)) nil)
- (set-marker (cdr (car stack)) nil)
- (setq stack (cdr stack)))))
-
-(defun folding-check-if-folding-allowed ()
- "Return non-nil when buffer allowed to be folded automatically.
-When buffer is loaded it may not be desirable to fold it immediately,
-because the file may be too large, or it may contain fold marks, that
-really are not _real_ folds. (Eg. RMAIL saved files may have the
-marks)
-
-This function returns t, if it's okay to proceed checking the fold status
-of file. Returning nil means that folding should not touch this file.
-
-The variable `folding-check-allow-folding-function' normally contains this
-function. Change the variable to use your own scheme."
-
- (or (let ((file (get 'find-file-noselect 'folding)))
- ;; When a file reference is "pushed" is a C-h v buffer that says:
- ;; test is a Lisp function in `~/foo/tmp/test.el' A flag gets set
- ;; (see adviced code) and we must not fold this buffer, because
- ;; it will be immediately searched.
- (and file
- (not (string-match (regexp-quote file)
- (or buffer-file-name "")))))
- ;; Do not fold these files
- (null (string-match folding-mode-hook-no-regexp (buffer-name)))))
-
-(defun folding-mode-find-file ()
- "One of the funcs called whenever a `find-file' is successful.
-It checks to see if `folded-file' has been set as a buffer-local
-variable, and automatically starts Folding mode if it has.
-
-This allows folded files to be automatically folded when opened.
-
-To make this hook effective, the symbol `folding-mode-find-file-hook'
-should be placed at the end of `find-file-hooks'. If you have
-some other hook in the list, for example a hook to automatically
-uncompress or decrypt a buffer, it should go earlier on in the list.
-
-See also `folding-mode-add-find-file-hook'."
- (let* ((check-fold folding-check-folded-file-function)
- (allow-fold folding-check-allow-folding-function))
- ;; Turn mode on only if it's allowed
- (if (funcall allow-fold)
- (or (and (and check-fold (funcall check-fold))
- (folding-mode 1))
- (and (assq 'folded-file (buffer-local-variables))
- folded-file
- (folding-mode 1)
- (kill-local-variable 'folded-file)))
- ;; In all other cases, unfold buffer.
- (if folding-mode
- (folding-mode -1)))))
-
-;;;###autoload
-(defun folding-mode-add-find-file-hook ()
- "Append `folding-mode-find-file-hook' to the list `find-file-hooks'.
-
-This has the effect that afterwards, when a folded file is visited, if
-appropriate Emacs local variable entries are recognized at the end of
-the file, Folding mode is started automatically.
-
-If `inhibit-local-variables' is non-nil, this will not happen regardless
-of the setting of `find-file-hooks'.
-
-To declare a file to be folded, put `folded-file: t' in the file's
-local variables. eg., at the end of a C source file, put:
-
-/*
-Local variables:
-folded-file: t
-*/
-
-The local variables can be inside a fold."
- (interactive)
- (or (memq 'folding-mode-find-file (symbol-value (folding-find-file-hook)))
- (add-hook (folding-find-file-hook) 'folding-mode-find-file 'end)))
-
-(defun folding-mode-write-file ()
- "Folded files must be controlled by folding before saving.
-This function turns on the folding mode if it is not activated.
-It prevents 'binary pollution' upon save."
- (let* ((check-func folding-check-folded-file-function)
- (no-re folding-mode-hook-no-regexp)
- (bn (or (buffer-name) "")))
- (if (and (not (string-match no-re bn))
- (boundp 'folding-mode)
- (null folding-mode)
- (and check-func (funcall check-func)))
- (progn
- ;; When folding mode is turned on it also 'folds' whole
- ;; buffer... can't avoid that, since it's more important
- ;; to save safely
- (folding-mode 1)))
- ;; hook returns nil, good habit
- nil))
-
-(defun folding-check-folded ()
- "Function to determine if this file is in folded form."
- (let* ( ;; Could use folding-top-regexp , folding-bottom-regexp ,
- ;; folding-regexp But they are not available at load time.
- (folding-re1 "^.?.?.?{{{")
- (folding-re2 "[\r\n].*}}}"))
- (save-excursion
- (goto-char (point-min))
- ;; If we found both, we assume file is folded
- (and (re-search-forward folding-re1 nil t)
- ;; if file is folded, there are \r's
- (search-forward "\r" nil t)
- (re-search-forward folding-re2 nil t)))))
-
-;;}}}
-
-;;{{{ code: Folding mode
-
-(defun folding-font-lock-keywords (&optional mode)
- "Return folding font-lock keywords for MODE."
- ;; Add support mode-by-mode basis. Check if mode is already
- ;; handled from the property list.
- (destructuring-bind (beg end ignore)
- (folding-get-mode-marks (or mode major-mode))
- ;; `ignore' is not used, add no-op for byte compiler
- (or ignore
- (setq ignore t))
- (setq beg (concat "^[ \t]*" (regexp-quote beg) "[^\r\n]+"))
- (setq end (concat "^[ \t]*" (regexp-quote end)))
- (list
- ;; the `t' says to overwrite any previous highlight.
- ;; => Needed because folding marks are in comments.
- (list beg 0 folding-font-lock-begin-mark t)
- (list end 0 folding-font-lock-end-mark t))))
-
-(defun folding-font-lock-support-instantiate (&optional mode)
- "Add fold marks with `font-lock-add-keywords'."
- (or mode
- (setq mode major-mode))
- ;; Hide function from Byte Compiler.
- (let ((function 'font-lock-add-keywords))
- (when (fboundp function)
- (funcall function
- mode
- (folding-font-lock-keywords mode))
- ;; In order to see new keywords font lock must be restarted.
- (dolist (buffer (buffer-list))
- (with-current-buffer buffer
- (when (and (eq major-mode mode)
- (or font-lock-mode
- (and (boundp 'global-font-lock-mode)
- global-font-lock-mode)))
- ;; FIXME: Crude fix. should we use font-lock-fontify-buffer instead?
- (font-lock-mode -1)
- (font-lock-mode 1)))))))
-
-(defun folding-font-lock-support ()
- "Add font lock support."
- (let ((list (get 'folding-mode 'font-lock)))
- (unless (memq major-mode list)
- ;; Support added, update known list
- (push major-mode list)
- (put 'folding-mode 'font-lock list)
- (folding-font-lock-support-instantiate major-mode))))
-
-(defun folding-set-local-variables ()
- "Set local fold mark variables.
-If you're going to change the beginning and end mark in
-`folding-mode-marks-alist'; you must call this function."
- (set (make-local-variable 'folding-stack) nil)
- (make-local-variable 'folding-top-mark)
- (make-local-variable 'folding-secondary-top-mark)
- (make-local-variable 'folding-top-regexp)
- (make-local-variable 'folding-bottom-mark)
- (make-local-variable 'folding-bottom-regexp)
- (make-local-variable 'folding-regexp)
- (or (and (boundp 'folding-top-regexp)
- folding-top-regexp
- (boundp 'folding-bottom-regexp)
- folding-bottom-regexp)
- (let ((folding-marks (assq major-mode
- folding-mode-marks-alist)))
- (if folding-marks
- (setq folding-marks (cdr folding-marks))
- (setq folding-marks '("{{{" "}}}")))
- (apply 'folding-set-marks folding-marks))))
-
-;;;###autoload
-(defun turn-off-folding-mode ()
- "Turn off folding."
- (folding-mode -1))
-
-;;;###autoload
-(defun turn-on-folding-mode ()
- "Turn on folding."
- (folding-mode 1))
-
-;;;###autoload
-(defun folding-mode (&optional arg inter)
- "A folding-editor-like minor mode. ARG INTER.
-
-These are the basic commands that Folding mode provides:
-
-\\{folding-mode-map}
-
-Keys starting with `folding-mode-prefix-key'
-
-\\{folding-mode-prefix-map}
-
- folding-convert-buffer-for-printing:
- `\\[folding-convert-buffer-for-printing]'
- Makes a ready-to-print, formatted, unfolded copy in another buffer.
-
- Read the documentation for the above functions for more information.
-
-Overview
-
- Folds are a way of hierarchically organizing the text in a file, so
- that the text can be viewed and edited at different levels. It is
- similar to Outline mode in that parts of the text can be hidden from
- view. A fold is a region of text, surrounded by special \"fold marks\",
- which act like brackets, grouping the text. Fold mark pairs can be
- nested, and they can have titles. When a fold is folded, the text is
- hidden from view, except for the first line, which acts like a title
- for the fold.
-
- Folding mode is a minor mode, designed to cooperate with many other
- major modes, so that many types of text can be folded while they are
- being edited (eg., plain text, program source code, Texinfo, etc.).
-
-Folding-mode function
-
- If Folding mode is not called interactively (`(interactive-p)' is nil),
- and it is called with two or less arguments, all of which are nil, then
- the point will not be altered if `folding-folding-on-startup' is set
- and `folding-whole-buffer' is called. This is generally not a good
- thing, as it can leave the point inside a hidden region of a fold, but
- it is required if the local variables set \"mode: folding\" when the
- file is first read (see `hack-local-variables').
-
- Not that you should ever want to, but to call Folding mode from a
- program with the default behavior (toggling the mode), call it with
- something like `(folding-mode nil t)'.
-
-Fold marks
-
- For most types of folded file, lines representing folds have \"{{{\"
- near the beginning. To enter a fold, move the point to the folded line
- and type `\\[folding-shift-in]'. You should no longer be able to see
- the rest of the file, just the contents of the fold, which you couldn't
- see before. You can use `\\[folding-shift-out]' to leave a fold, and
- you can enter and exit folds to move around the structure of the file.
-
- All of the text is present in a folded file all of the time. It is just
- hidden. Folded text shows up as a line (the top fold mark) with \"...\"
- at the end. If you are in a fold, the mode line displays \"inside n
- folds Narrow\", and because the buffer is narrowed you can't see outside
- of the current fold's text.
-
- By arranging sections of a large file in folds, and maybe subsections
- in sub-folds, you can move around a file quickly and easily, and only
- have to scroll through a couple of pages at a time. If you pick the
- titles for the folds carefully, they can be a useful form of
- documentation, and make moving though the file a lot easier. In
- general, searching through a folded file for a particular item is much
- easier than without folds.
-
-Managing folds
-
- To make a new fold, set the mark at one end of the text you want in the
- new fold, and move the point to the other end. Then type
- `\\[folding-fold-region]'. The text you selected will be made into a
- fold, and the fold will be entered. If you just want a new, empty fold,
- set the mark where you want the fold, and then create a new fold there
- without moving the point. Don't worry if the point is in the middle of
- a line of text, `folding-fold-region' will not break text in the middle
- of a line. After making a fold, the fold is entered and the point is
- positioned ready to enter a title for the fold. Do not delete the fold
- marks, which are usually something like \"{{{\" and \"}}}\". There may
- also be a bit of fold mark which goes after the fold title.
-
- If the fold markers get messed up, or you just want to see the whole
- unfolded file, use `\\[folding-open-buffer]' to unfolded the whole
- file, so you can see all the text and all the marks. This is useful for
- checking/correcting unbalanced fold markers, and for searching for
- things. Use `\\[folding-whole-file]' to fold the buffer again.
-
- `folding-shift-out' will attempt to tidy the current fold just before
- exiting it. It will remove any extra blank lines at the top and bottom,
- \(outside the fold marks). It will then ensure that fold marks exists,
- and if they are not, will add them (after asking). Finally, the number
- of blank lines between the fold marks and the contents of the fold is
- set to 1 (by default).
-
-Folding package customizations
-
- If the fold marks are not set on entry to Folding mode, they are set to
- a default for current major mode, as defined by
- `folding-mode-marks-alist' or to \"{{{ \" and \"}}}\" if none are
- specified.
-
- To bind different commands to keys in Folding mode, set the bindings in
- the keymap `folding-mode-map'.
-
- The hooks `folding-mode-hook' and `<major-mode-name>-folding-hook' are
- called before folding the buffer and applying the key bindings in
- `folding-mode-map'. This is a good hook to set extra or different key
- bindings in `folding-mode-map'. Note that key bindings in
- `folding-mode-map' are only examined just after calling these hooks;
- new bindings in those maps only take effect when Folding mode is being
- started. The hook `folding-load-hook' is called when Folding mode is
- loaded into Emacs.
-
-Mouse behavior
-
- If you want folding to detect point of actual mouse click, please see
- variable `folding-mouse-yank-at-p'.
-
- To customise the mouse actions, look at `folding-behave-table'."
- (interactive)
-
- (let ((new-folding-mode
- (if (not arg)
- (not folding-mode)
- (> (prefix-numeric-value arg) 0))))
- (or (eq new-folding-mode
- folding-mode)
- (if folding-mode
- (progn
- ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ progn ^^^
- ;; turn off folding
- (if (null (folding-use-overlays-p))
- (setq selective-display nil))
- (folding-clear-stack)
- (folding-narrow-to-region nil nil)
- (folding-subst-regions (list 1 (point-max)) ?\r ?\n)
-
- ;; Restore "%n" (Narrow) in the mode line
- (setq mode-line-format
- (mapcar
- (function
- (lambda (item)
- (if (equal item 'folding-narrow-placeholder)
- "%n" item)))
- mode-line-format)))
- ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ else ^^^
- (cond
- ((folding-use-overlays-p)
- ;; This may be Emacs specific; how about XEmacs?
- ;;
- ;; make line-move-ignore-invisible buffer local, matches
- ;; outline.el, and the 21 pre-release gets upset if this is
- ;; defined globally in shell buffer...
- (make-local-variable 'line-move-ignore-invisible)
- (setq line-move-ignore-invisible t
- buffer-invisibility-spec '((t . t))))
- (t
- (setq selective-display t)
- (setq selective-display-ellipses t)))
- (unless (assq 'folding-mode minor-mode-alist)
- ;; User has not run folding-install or he did call
- ;; folding-uninstall which completely wiped package out.
- ;; => anyway now he calls us, so be there for him
- (folding-install))
- (folding-keep-hooked) ;set hooks if not there
- (widen)
- (setq folding-narrow-overlays nil)
- (folding-set-local-variables)
- (folding-font-lock-support)
- (unwind-protect
- (let ((hook-symbol (intern-soft
- (concat
- (symbol-name major-mode)
- "-folding-hook"))))
- (run-hooks 'folding-mode-hook)
- (and hook-symbol
- (run-hooks hook-symbol)))
- (folding-set-mode-line))
- (and folding-folding-on-startup
- (if (or (interactive-p)
- arg
- inter)
- (folding-whole-buffer)
- (save-excursion
- (folding-whole-buffer))))
- (folding-narrow-to-region nil nil t)
- ;; Remove "%n" (Narrow) from the mode line
- (setq mode-line-format
- (mapcar
- (function
- (lambda (item)
- (if (equal item "%n")
- 'folding-narrow-placeholder item)))
- mode-line-format))))
- (setq folding-mode new-folding-mode)
- (if folding-mode
- (easy-menu-add folding-mode-menu)
- (easy-menu-remove folding-mode-menu))))
-
-;;}}}
-;;{{{ code: setting fold marks
-
-;; You think those "\\(\\)" pairs are peculiar? Me too. Emacs regexp
-;; stuff has a bug; sometimes "\\(.*\\)" fails when ".*" succeeds, but
-;; only in a folded file! Strange bug! Must check it out sometime.
-
-(defun folding-set-marks (top bottom &optional secondary)
- "Set the folding top and bottom mark for the current buffer.
-
-Input:
-
- TOP The topmost fold mark. Comment start + fold begin string.
- BOTTOM The bottom fold mark Comment end + fold end string.
- SECONDARY Usually the comment end indicator for the mode. This
- is inserted by `folding-fold-region' after the fold top mark,
- and is presumed to be put after the title of the fold.
-
-Example:
-
- html-mode:
-
- top: \"<!-- [[[ \"
- bot: \"<!-- ]]] -->\"
- sec: \" -->\"
-
-Notice that the top marker needs to be closed with SECONDARY comment end string.
-
-Various regular expressions are set with this function, so don't set the
-mark variables directly."
- (set (make-local-variable 'folding-top-mark)
- top)
- (set (make-local-variable 'folding-bottom-mark)
- bottom)
- (set (make-local-variable 'folding-secondary-top-mark)
- secondary)
- (set (make-local-variable 'folding-top-regexp)
- (concat "\\(^\\|\r+\\)[ \t]*"
- (regexp-quote folding-top-mark)))
- (set (make-local-variable 'folding-bottom-regexp)
- (concat "\\(^\\|\r+\\)[ \t]*"
- (regexp-quote folding-bottom-mark)))
- (set (make-local-variable 'folding-regexp)
- (concat "\\(^\\|\r\\)\\([ \t]*\\)\\(\\("
- (regexp-quote folding-top-mark)
- "\\)\\|\\("
- (regexp-quote folding-bottom-mark)
- "[ \t]*\\(\\)\\($\\|\r\\)\\)\\)")))
-
-;;}}}
-;;{{{ code: movement
-
-(defun folding-next-visible-heading (&optional direction)
- "Move up/down fold headers.
-Backward if DIRECTION is non-nil returns nil if not moved = no next marker."
- (interactive)
- (let* ((begin-mark (nth 0 (folding-get-mode-marks)))
- case-fold-search)
- (if direction
- (re-search-backward (concat "^" (regexp-quote begin-mark)) nil t)
- (re-search-forward (concat "^" (regexp-quote begin-mark)) nil t))))
-
-(defun folding-previous-visible-heading ()
- "Move upward fold headers."
- (interactive)
- (beginning-of-line)
- (folding-next-visible-heading 'backward))
-
-(defun folding-find-folding-mark (&optional end-fold)
- "Search backward to find beginning fold. Skips subfolds.
-Optionally searches forward to find END-FOLD mark.
-
-Return:
-
- nil
- point position of fold mark"
- (let* (case-fold-search
- (elt (folding-get-mode-marks))
- (bm (regexp-quote (nth 0 elt))) ; markers defined for mode
- (em (regexp-quote (nth 1 elt))) ; markers defined for mode
- (re (concat "^" bm "\\|^" em))
- (count 0)
- stat
- moved)
- (save-excursion
- (cond
- (end-fold
- (folding-end-of-line)
- ;; We must skip over inner folds
- (while (and (null moved)
- (re-search-forward re nil t))
- (setq stat (folding-mark-look-at))
- (cond
- ((symbolp stat)
- (setq count (1- count))
- (if (< count 0) ;0 or less means no middle folds
- (setq moved t)))
- ((memq stat '(1 11)) ;BEG fold
- (setq count (1+ count))))) ;; end while
- (when moved
- (forward-char -3)
- (setq moved (point))))
- (t
- (while (and (null moved)
- (re-search-backward re nil t))
- (setq stat (folding-mark-look-at))
- (cond
- ((memq stat '(1 11))
- (setq count (1- count))
- (if (< count 0) ;0 or less means no middle folds
- (setq moved (point))))
- ((symbolp stat)
- (setq count (1+ count)))))
- (when moved ;What's the result
- (forward-char 3)
- (setq moved (point))))))
- moved))
-
-(defun folding-pick-move ()
- "Pick the logical movement on fold mark.
-If at the end of fold, then move to the beginning and vice versa.
-
-If placed over closed fold moves to the next fold. When no next
-folds are visible, stops moving.
-
-Return:
- t if moved"
- (interactive)
- (let* (case-fold-search
- (elt (folding-get-mode-marks))
- (bm (nth 0 elt)) ; markers defined for mode
- (stat (folding-mark-look-at))
- moved)
- (cond
- ((eq 0 stat) ;closed fold
- (when (re-search-forward (concat "^" (regexp-quote bm)) nil t)
- (setq moved t)
- (forward-char 3)))
- ((symbolp stat) ;End fold
- (setq moved (folding-find-folding-mark)))
- ((integerp stat) ;Beg fold
- (setq moved (folding-find-folding-mark 'end-fold))))
- (if (integerp moved)
- (goto-char moved))
- moved))
-
-;;; Idea by Scott Evans <gse A T antisleep com>
-(defun folding-context-next-action ()
- "Take next action according to point and context.
-If point is at:
-
- Begin Fold : toggle open - close
- End Fold : close
- inside : fold current level."
- (interactive)
- (let ((state (folding-mark-look-at)))
- (cond
- ((eq state 0)
- (folding-act 'open))
- ((eq state 1)
- (folding-act 'close))
- ((eq state 11)
- (folding-act 'up))
- ((eq 'end state)
- (folding-act 'close))
- ((eq state 'end-in)
- (folding-act 'up))
- (t
- (folding-act 'other)))))
-
-(defun folding-forward-char-1 (&optional arg)
- "See `folding-forward-char-1' for ARG."
- (if (eq arg 1)
- ;; Do it a faster way for arg = 1.
- (if (eq (following-char) ?\r)
- (let ((saved (point))
- (inhibit-quit t))
- (end-of-line)
- (if (not (eobp))
- (forward-char)
- (goto-char saved)
- (error "End of buffer")))
- ;; `forward-char' here will do its own error if (eobp).
- (forward-char))
- (if (> 0 (or arg (setq arg 1)))
- (folding-backward-char (- arg))
- (let (goal saved)
- (while (< 0 arg)
- (skip-chars-forward "^\r" (setq goal (+ (point) arg)))
- (if (eq goal (point))
- (setq arg 0)
- (if (eobp)
- (error "End of buffer")
- (setq arg (- goal 1 (point))
- saved (point))
- (let ((inhibit-quit t))
- (end-of-line)
- (if (not (eobp))
- (forward-char)
- (goto-char saved)
- (error "End of buffer"))))))))))
-
-(defmacro folding-forward-char-macro ()
- `(defun folding-forward-char (&optional arg)
- "Move point right ARG characters, skipping hidden folded regions.
-Moves left if ARG is negative. On reaching end of buffer, stop and
-signal error."
- ,(folding-interactive-spec-p)
- ;; (folding-preserve-active-region)
- (folding-forward-char-1 arg)))
-
-(folding-forward-char-macro)
-
-(defun folding-backward-char-1 (&optional arg)
- "See `folding-backward-char-1' for ARG."
- (if (eq arg 1)
- ;; Do it a faster way for arg = 1.
- ;; Catch the case where we are in a hidden region, and bump into a \r.
- (if (or (eq (preceding-char) ?\n)
- (eq (preceding-char) ?\r))
- (let ((pos (1- (point)))
- (inhibit-quit t))
- (forward-char -1)
- (beginning-of-line)
- (skip-chars-forward "^\r" pos))
- (forward-char -1))
- (if (> 0 (or arg (setq arg 1)))
- (folding-forward-char (- arg))
- (let (goal)
- (while (< 0 arg)
- (skip-chars-backward "^\r\n" (max (point-min)
- (setq goal (- (point) arg))))
- (if (eq goal (point))
- (setq arg 0)
- (if (bobp)
- (error "Beginning of buffer")
- (setq arg (- (point) 1 goal)
- goal (point))
- (let ((inhibit-quit t))
- (forward-char -1)
- (beginning-of-line)
- (skip-chars-forward "^\r" goal)))))))))
-
-(defmacro folding-backward-char-macro ()
- `(defun folding-backward-char (&optional arg)
- "Move point right ARG characters, skipping hidden folded regions.
-Moves left if ARG is negative. On reaching end of buffer, stop and
-signal error."
- ,(folding-interactive-spec-p)
- ;; (folding-preserve-active-region)
- (folding-backward-char-1 arg)))
-
-(folding-backward-char-macro)
-
-(defmacro folding-end-of-line-macro ()
- `(defun folding-end-of-line (&optional arg)
- "Move point to end of current line, but before hidden folded region.
-ARG is line count.
-
-Has the same behavior as `end-of-line', except that if the current line
-ends with some hidden folded text (represented by an ellipsis), the
-point is positioned just before it. This prevents the point from being
-placed inside the folded text, which is not normally useful."
- ,(folding-interactive-spec-p)
- ;;(interactive "p")
- ;; (folding-preserve-active-region)
- (if (or (eq arg 1)
- (not arg))
- (beginning-of-line)
- ;; `forward-line' also moves point to beginning of line.
- (forward-line (1- arg)))
- (skip-chars-forward "^\r\n")))
-
-(folding-end-of-line-macro)
-
-(defun folding-skip-ellipsis-backward ()
- "Move the point backwards out of folded text.
-
-If the point is inside a folded region, the cursor is displayed at the
-end of the ellipsis representing the folded part. This function checks
-to see if this is the case, and if so, moves the point backwards until
-it is just outside the hidden region, and just before the ellipsis.
-
-Returns t if the point was moved, nil otherwise."
- (interactive)
- (let ((pos (point))
- result)
- (save-excursion
- (beginning-of-line)
- (skip-chars-forward "^\r" pos)
- (or (eq pos (point))
- (setq pos (point)
- result t)))
- (goto-char pos)
- result))
-
-;;}}}
-
-;;{{{ code: Moving in and out of folds
-
-;;{{{ folding-shift-in
-
-(defun folding-shift-in (&optional noerror)
- "Open and enter the fold at or around the point.
-
-Enters the fold that the point is inside, wherever the point is inside
-the fold, provided it is a valid fold with balanced top and bottom
-marks. Returns nil if the fold entered contains no sub-folds, t
-otherwise. If an optional argument NOERROR is non-nil, returns nil if
-there are no folds to enter, instead of causing an error.
-
-If the point is inside a folded, hidden region (as represented by an
-ellipsis), the position of the point in the buffer is preserved, and as
-many folds as necessary are entered to make the surrounding text
-visible. This is useful after some commands eg., search commands."
- (interactive)
- (labels
- ((open-fold nil
- (let ((data (folding-show-current-entry noerror t)))
- (and data
- (progn
- (when folding-narrow-by-default
- (setq folding-stack
- (if folding-stack
- (cons (cons (point-min-marker)
- (point-max-marker))
- folding-stack)
- '(folded)))
- (folding-set-mode-line))
- (folding-narrow-to-region (car data) (nth 1 data)))))))
- (let ((goal (point)))
- (while (folding-skip-ellipsis-backward)
- (beginning-of-line)
- (open-fold)
- (goto-char goal))
- (when (not folding-narrow-by-default)
- (widen)))))
-
-;;}}}
-;;{{{ folding-shift-out
-
-(defun folding-shift-out (&optional event)
- "Exits the current fold with EVENT."
- (interactive)
- (if folding-stack
- (progn
- (folding-tidy-inside)
- (cond
- ((folding-use-overlays-p)
- (folding-subst-regions
- (list (overlay-end (car folding-narrow-overlays))
- (overlay-start (cdr folding-narrow-overlays))) ?\n ?\r)
- ;; So point is correct in other windows.
- (goto-char (overlay-end (car folding-narrow-overlays))))
- (t
- (folding-subst-regions (list (point-min) (point-max)) ?\n ?\r)
- ;; So point is correct in other window
- (goto-char (point-min))))
-
- (if (eq (car folding-stack) 'folded)
- (folding-narrow-to-region nil nil t)
- (folding-narrow-to-region
- (marker-position (car (car folding-stack)))
- (marker-position (cdr (car folding-stack))) t))
- (and (consp (car folding-stack))
- (set-marker (car (car folding-stack)) nil)
- (set-marker (cdr (car folding-stack)) nil))
- (setq folding-stack (cdr folding-stack)))
- (error "Outside all folds"))
- (folding-set-mode-line))
-
-;;}}}
-;;{{{ folding-show-current-entry
-
-(defun folding-show-current-entry (&optional event noerror noskip)
- "Opens the fold that the point is on, but does not enter it.
-EVENT and optional arg NOERROR means don't signal an error if there is
-no fold, just return nil. NOSKIP means don't jump out of a hidden
-region first.
-
-Returns ((START END SUBFOLDS-P). START and END indicate the extents of
-the fold that was shown. If SUBFOLDS-P is non-nil, the fold contains
-subfolds."
- (interactive)
- (or noskip
- (folding-skip-ellipsis-backward))
- (let ((point (point))
- backward
- forward
- start
- end
- subfolds-not-p)
- (unwind-protect
- (or (and (integerp
- (car-safe (setq backward (folding-skip-folds t))))
- (integerp
- (car-safe (setq forward (folding-skip-folds nil))))
- (progn
- (goto-char (car forward))
- (skip-chars-forward "^\r\n")
- (setq end (point))
- (skip-chars-forward "\r\n")
- (not (and folding-stack (eobp))))
- (progn
- (goto-char (car backward))
- (skip-chars-backward "^\r\n")
- (setq start (point))
- (skip-chars-backward "\r\n")
- (not (and folding-stack (bobp))))
- (progn
- (setq point start)
- ;; Avoid holding the list through a GC.
- (setq subfolds-not-p
- (not (or (cdr backward)
- (cdr forward))))
- (folding-subst-regions
- (append backward (nreverse forward))
- ?\r ?\n)
- ;; FIXME: this should be moved to font-lock:
- ;; - When fold is closed, the whole line (with code)
- ;; is treated as comment
- ;; - Fon-lock changes all fonts to `font-lock-comment-face'
- ;; - When you again open fold, all text is in color
- ;;
- ;; => Font lock should stop at \r, and not use ".*"
- ;; which includes \r character
- ;; This is a workaround, not an efficient one
- (if (or (and (boundp 'global-font-lock-mode)
- global-font-lock-mode)
- font-lock-mode)
- (font-lock-fontify-region start end))
- (list start end (not subfolds-not-p))))
- (if noerror
- nil
- (error "Not on a fold")))
- (goto-char point))))
-
-;;}}}
-;;{{{ folding-hide-current-entry
-
-(defun folding-toggle-enter-exit ()
- "Run `folding-shift-in' or `folding-shift-out'.
-This depends on current line's contents."
- (interactive)
- (beginning-of-line)
- (let ((current-line-mark (folding-mark-look-at)))
- (if (and (numberp current-line-mark)
- (= current-line-mark 0))
- (folding-shift-in)
- (folding-shift-out))))
-
-(defun folding-toggle-show-hide ()
- "Run folding-show-current-entry or folding-hide-current-entry depending on current line's contents."
- (interactive)
- (beginning-of-line)
- (let ((current-line-mark (folding-mark-look-at)))
- (if (and (numberp current-line-mark)
- (= current-line-mark 0))
- (folding-show-current-entry)
- (folding-hide-current-entry))))
-
-(defun folding-hide-current-entry (&optional event)
- "Close the fold around the point using EVENT.
-Undo effect of `folding-show-current-entry'."
- (interactive)
- (folding-skip-ellipsis-backward)
- (let (start end)
- (if (and (integerp (setq start (car-safe (folding-skip-folds t))))
- (integerp (setq end (car-safe (folding-skip-folds nil)))))
- (if (and folding-stack
- (or (eq start (point-min))
- (eq end (point-max))))
- ;;(error "Cannot hide current fold")
- (folding-shift-out)
- (goto-char start)
- (skip-chars-backward "^\r\n")
- (folding-subst-regions (list start end) ?\n ?\r))
- (error "Not on a fold"))))
-
-;;}}}
-;;{{{ folding-show-all
-
-(defun folding-show-all ()
- "Exits all folds, to the top level."
- (interactive)
- (while folding-stack
- (folding-shift-out)))
-
-;;}}}
-;;{{{ folding-goto-line
-
-(defun folding-goto-line (line)
- "Go to LINE, entering as many folds as possible."
- (interactive "NGoto line: ")
- (folding-show-all)
- (goto-char 1)
- (and (< 1 line)
- (re-search-forward "[\n\C-m]" nil 0 (1- line)))
- (let ((goal (point)))
- (while (prog2 (beginning-of-line)
- (folding-shift-in t)
- (goto-char goal))))
- (folding-narrow-to-region
- (and folding-narrow-by-default (point-min))
- (point-max) t))
-
-;;}}}
-
-;;}}}
-;;{{{ code: Searching for fold boundaries
-
-;;{{{ folding-skip-folds
-
-(defun folding-skip-folds (backward &optional outside)
- "Skips forward through the buffer (backward if BACKWARD is non-nil)
-until it finds a closing fold mark or the end of the buffer. The
-point is not moved. Jumps over balanced folding-mark pairs on the way.
-Returns t if the end of buffer was found in an unmatched folding-mark
-pair, otherwise a list.
-
-If the point is actually on an fold start mark, the mark is ignored;
-if it is on an end mark, the mark is noted. This decision is
-reversed if BACKWARD is non-nil. If optional OUTSIDE is non-nil and
-BACKWARD is nil, either mark is noted.
-
-The first element of the list is a position in the end of the closing
-fold mark if one was found, or nil. It is followed by (END START)
-pairs (flattened, not a list of pairs). The pairs indicating the
-positions of folds skipped over; they are positions in the fold
-marks, not necessarily at the ends of the fold marks. They are in
-the opposite order to that in which they were skipped. The point is
-left in a meaningless place. If going backwards, the pairs are
-\(START END) pairs, as the fold marks are scanned in the opposite
-order.
-
-Works by maintaining the position of the top and bottom marks found
-so far. They are found separately using a normal string search for
-the fixed part of a fold mark (because it is faster than a regexp
-search if the string does not occur often outside of fold marks),
-checking that it really is a proper fold mark, then considering the
-earliest one found. The position of the other (if found) is
-maintained to avoid an unnecessary search at the next iteration."
- (let ((first-mark (if backward folding-bottom-mark folding-top-mark))
- (last-mark (if backward folding-top-mark folding-bottom-mark))
- (top-re folding-top-regexp)
- (depth 0)
- pairs point
- temp
- start
- first
- last
- case-fold-search)
- ;; Ignore trailing space?
- (when nil
- (when (and (stringp first-mark)
- (string-match "^\\(.*[^ ]+\\) +$" first-mark))
- (setq first-mark (match-string 1 first-mark)))
- (when (and (stringp last-mark)
- (string-match "^\\(.*[^ ]+\\) +$" last-mark))
- (setq last-mark (match-string 1 last-mark)))
- (when (and (stringp top-re)
- (string-match "^\\(.*[^ ]+\\) +$" top-re))
- (setq top-re (match-string 1 top-re))))
- (save-excursion
- (skip-chars-backward "^\r\n")
- (unless outside
- (and (eq (preceding-char) ?\r)
- (forward-char -1))
- (if (looking-at top-re)
- (if backward
- (setq last (match-end 1))
- (skip-chars-forward "^\r\n"))))
- (while (progn
- ;; Find last first, prevents unnecessary searching
- ;; for first.
- (setq point (point))
- (or last
- (while (and (if backward
- (search-backward last-mark first t)
- (search-forward last-mark first t))
- (progn
- (setq temp (point))
- (goto-char (match-beginning 0))
- (skip-chars-backward " \t")
- (and (not
- (setq last
- (if (eq (preceding-char) ?\r)
- temp
- (and (bolp) temp))))
- (goto-char temp)))))
- (goto-char point))
- (or first
- (while (and (if backward
- (search-backward first-mark last t)
- (search-forward first-mark last t))
- (progn
- (setq temp (point))
- (goto-char (match-beginning 0))
- (skip-chars-backward " \t")
- (and (not
- (setq first
- (if (eq (preceding-char) ?\r)
- temp
- (and (bolp) temp))))
- (goto-char temp))))))
- ;; Return value of conditional says whether to
- ;; iterate again.
- (if (not last)
- ;; Return from this with the result.
- (not (setq pairs (if first t (cons nil pairs))))
- (if (and first
- (if backward
- (> first last)
- (< first last)))
- (progn
- (goto-char first)
- (if (eq 0 depth)
- (setq start first
- first nil
- depth 1) ;; non-nil value, loop again.
- (setq first nil
- ;; non-nil value => loop again
- depth (1+ depth))))
- (goto-char last)
- (if (eq 0 depth)
- (not (setq pairs (cons last pairs)))
- (or (< 0 (setq depth (1- depth)))
- (setq pairs (cons last (cons start pairs))))
- (setq last nil)
- t)))))
- pairs)))
-
-;;}}}
-
-;;}}}
-;;{{{ code: Functions that actually modify the buffer
-
-;;{{{ folding-fold-region
-
-(defun folding-fold-region (start end)
- "Places fold mark at the beginning and end of a specified region.
-The region is specified by two arguments START and END. The point is
-left at a suitable place ready to insert the title of the fold.
-
-The fold markers are intended according to mode."
- (interactive "r")
- (and (< end start)
- (setq start (prog1 end
- (setq end start))))
- (setq end (set-marker (make-marker) end))
- (goto-char start)
- (beginning-of-line)
- (setq start (point))
- (insert-before-markers folding-top-mark)
- ;; XEmacs latex-mode, after (tex-site), indents the whole
- ;; fold 50 characters right. Don't do that.
- (unless (string-match "latex" (symbol-name major-mode))
- (indent-according-to-mode))
- (let ((saved-point (point)))
- (and folding-secondary-top-mark
- (insert-before-markers folding-secondary-top-mark))
- (insert-before-markers ?\n)
- (goto-char (marker-position end))
- (set-marker end nil)
- (and (not (bolp))
- (eq 0 (forward-line))
- (eobp)
- (insert ?\n))
- (insert folding-bottom-mark)
- (unless (string-match "latex" (symbol-name major-mode))
- (indent-according-to-mode))
- (insert ?\n)
- (setq folding-stack (if folding-stack
- (cons (cons (point-min-marker)
- (point-max-marker))
- folding-stack)
- '(folded)))
- (folding-narrow-to-region start (1- (point)))
- (goto-char saved-point)
- (folding-set-mode-line))
- (save-excursion (folding-tidy-inside)))
-
-;;}}}
-;;{{{ folding-tidy-inside
-
-;; Note to self: The long looking code for checking and modifying those
-;; blank lines is to make sure the text isn't modified unnecessarily.
-;; Don't remove it again!
-
-(defun folding-tidy-inside ()
- "Add or remove blank lines at the top and bottom of the current fold.
-Also adds fold marks at the top and bottom (after asking), if they are not
-there already. The amount of space left depends on the variable
-`folding-internal-margins', which is one by default."
- (interactive)
- (if buffer-read-only nil
- (let ()
-;;; (top-re (if (string-match "^\\(.*\\) $" folding-top-mark)
-;;; (match-string 1 folding-top-mark)
-;;; folding-top-mark))
- (if (folding-use-overlays-p)
- (goto-char (- (overlay-end (car folding-narrow-overlays)) 1))
- (goto-char (point-min)))
- (and (eolp)
- (progn (skip-chars-forward "\n\t ")
- (delete-region (point-min) (point))))
- (and (if (let (case-fold-search) (folding-mark-look-at-top-mark-p))
- (progn (forward-line 1)
- (and (eobp) (insert ?\n))
- t)
- (and (y-or-n-p "Insert missing folding-top-mark? ")
- (progn (insert (concat folding-top-mark
- "<Replaced missing fold top mark>"
- (or folding-secondary-top-mark "")
- "\n"))
- t)))
- folding-internal-margins
- (<= 0 folding-internal-margins)
- (let* ((p1 (point))
- (p2 (progn (skip-chars-forward "\n") (point)))
- (p3 (progn (skip-chars-forward "\n\t ")
- (skip-chars-backward "\t " p2) (point))))
- (if (eq p2 p3)
- (or (eq p2 (setq p3 (+ p1 folding-internal-margins)))
- (if (< p2 p3)
- (newline (- p3 p2))
- (delete-region p3 p2)))
- (delete-region p1 p3)
- (or (eq 0 folding-internal-margins)
- (newline folding-internal-margins)))))
- (if (folding-use-overlays-p)
- (goto-char (overlay-start (cdr folding-narrow-overlays)))
- (goto-char (point-max)))
- (and (bolp)
- (progn (skip-chars-backward "\n")
- (delete-region (point) (point-max))))
- (beginning-of-line)
- (and (or (let (case-fold-search) (folding-mark-look-at-bottom-mark-p))
- (progn (goto-char (point-max)) nil)
- (and (y-or-n-p "Insert missing folding-bottom-mark? ")
- (progn
- (insert (concat "\n" folding-bottom-mark))
- (beginning-of-line)
- t)))
- folding-internal-margins
- (<= 0 folding-internal-margins)
- (let* ((p1 (point))
- (p2 (progn (skip-chars-backward "\n") (point)))
- (p3 (progn (skip-chars-backward "\n\t ")
- (skip-chars-forward "\t " p2) (point))))
- (if (eq p2 p3)
- (or (eq p2 (setq p3 (- p1 1 folding-internal-margins)))
- (if (> p2 p3)
- (newline (- p2 p3))
- (delete-region p2 p3)))
- (delete-region p3 p1)
- (newline (1+ folding-internal-margins))))))))
-
-;;}}}
-
-;;}}}
-;;{{{ code: Operations on the whole buffer
-
-;;{{{ folding-whole-buffer
-
-(defun folding-whole-buffer ()
- "Folds every fold in the current buffer.
-Fails if the fold markers are not balanced correctly.
-
-If the buffer is being viewed in a fold, folds are repeatedly exited to
-get to the top level first (this allows the folds to be tidied on the
-way out). The buffer modification flag is not affected, and this
-function will work on read-only buffers."
-
- (interactive)
- (message "Folding buffer...")
- (let ((narrow-min (point-min))
- (narrow-max (point-max))
- folding-list)
- (save-excursion
- (widen)
- (goto-char 1)
- (setq folding-list (folding-skip-folds nil t))
- (narrow-to-region narrow-min narrow-max)
- (and (eq t folding-list)
- (error
- "Cannot fold whole buffer -- unmatched begin-fold mark `%s' ´%s'"
- (current-buffer)
- folding-top-mark))
- (and (integerp (car folding-list))
- (error
- "Cannot fold whole buffer -- extraneous end-fold mark `%s' `%s'"
- (current-buffer)
- folding-bottom-mark))
- (folding-show-all)
- (widen)
- (goto-char 1)
- ;; Do the modifications forwards.
- (folding-subst-regions (nreverse (cdr folding-list)) ?\n ?\r))
- (beginning-of-line)
- (folding-narrow-to-region nil nil t)
- (message "Folding buffer... done")))
-
-;;}}}
-;;{{{ folding-open-buffer
-
-(defun folding-open-buffer ()
- "Unfolds the entire buffer, leaving the point where it is.
-Does not affect the buffer-modified flag, and can be used on read-only
-buffers."
- (interactive)
- (message "Unfolding buffer...")
- (folding-clear-stack)
- (folding-set-mode-line)
- (unwind-protect
- (progn
- (widen)
- (folding-subst-regions (list 1 (point-max)) ?\r ?\n))
- (folding-narrow-to-region nil nil t))
- (message "Unfolding buffer... done"))
-
-;;}}}
-;;{{{ folding-convert-buffer-for-printing
-
-(defun folding-convert-buffer-for-printing (&optional buffer pre-title post-title pad)
- "Remove folds from a buffer, for printing.
-
-It copies the contents of the (hopefully) folded buffer BUFFER into a
-buffer called `*Unfolded: <Original-name>*', removing all of the fold
-marks. It keeps the titles of the folds, however, and numbers them.
-Subfolds are numbered in the form 5.1, 5.2, 5.3 etc., and the titles are
-indented to eleven characters.
-
-It accepts four arguments. BUFFER is the name of the buffer to be
-operated on, or a buffer. nil means use the current buffer. PRE-TITLE
-is the text to go before the replacement fold titles, POST-TITLE is the
-text to go afterwards. Finally, if PAD is non-nil, the titles are all
-indented to the same column, which is eleven plus the length of
-PRE-TITLE. Otherwise just one space is placed between the number and
-the title."
- (interactive (list (read-buffer "Remove folds from buffer: "
- (buffer-name)
- t)
- (read-string "String to go before enumerated titles: ")
- (read-string "String to go after enumerated titles: ")
- (y-or-n-p "Pad section numbers with spaces? ")))
- (set-buffer (setq buffer (get-buffer buffer)))
- (setq pre-title (or pre-title "")
- post-title (or post-title ""))
- (or folding-mode
- (error "Must be in Folding mode before removing folds"))
- (let* ((new-buffer (get-buffer-create (concat "*Unfolded: "
- (buffer-name buffer)
- "*")))
- (section-list '(1))
- (section-prefix-list '(""))
-
- (secondary-mark-length (length folding-secondary-top-mark))
-
- (secondary-mark folding-secondary-top-mark)
- (mode major-mode)
-
- ;; [jari] Aug 14 1997
- ;; Regexp doesn't allow "footer text" like, so we add one more
- ;; regexp to loosen the end criteria
- ;;
- ;; {{{ Subsubsection 1
- ;; }}} Subsubsection 1
- ;;
- ;; was: (regexp folding-regexp)
- ;;
- (regexp
- (concat "\\(^\\|\r\\)\\([ \t]*\\)\\(\\("
- (regexp-quote folding-top-mark)
- "\\)\\|\\("
- (regexp-quote folding-bottom-mark)
- "[ \t]*.*\\(\\)\\($\\|\r\\)\\)\\)"))
- title
- prefix)
- ;; was obsolete function: (buffer-flush-undo new-buffer)
- (buffer-disable-undo new-buffer)
- (save-excursion
- (set-buffer new-buffer)
- (delete-region (point-min)
- (point-max)))
- (save-restriction
- (widen)
- (copy-to-buffer new-buffer (point-min) (point-max)))
- (display-buffer new-buffer t)
- (set-buffer new-buffer)
- (subst-char-in-region (point-min) (point-max) ?\r ?\n)
- (funcall mode)
- (while (re-search-forward regexp nil t)
- (if (match-beginning 4)
- (progn
- (goto-char (match-end 4))
-
- ;; - Move after start fold and read the title from there
- ;; - Then move back and kill the fold mark
- ;;
- (setq title
- (buffer-substring (point)
- (progn (end-of-line)
- (point))))
- (delete-region (save-excursion
- (goto-char (match-beginning 4))
- (skip-chars-backward "\n\r")
- (point))
- (progn
- (skip-chars-forward "\n\r")
- (point)))
- (and (<= secondary-mark-length
- (length title))
- (string-equal secondary-mark
- (substring title
- (- secondary-mark-length)))
- (setq title (substring title
- 0
- (- secondary-mark-length))))
- (setq section-prefix-list
- (cons (setq prefix (concat (car section-prefix-list)
- (int-to-string (car section-list))
- "."))
- section-prefix-list))
- (or (cdr section-list)
- (insert ?\n))
- (setq section-list (cons 1
- (cons (1+ (car section-list))
- (cdr section-list))))
- (setq title (concat prefix
- (if pad
- (make-string
- (max 2 (- 8 (length prefix))) ? )
- " ")
- title))
- (message "Reformatting: %s%s%s"
- pre-title
- title
- post-title)
- (insert "\n\n"
- pre-title
- title
- post-title
- "\n\n"))
- (goto-char (match-beginning 5))
- (or (setq section-list (cdr section-list))
- (error "Too many bottom-of-fold marks"))
-
- (setq section-prefix-list (cdr section-prefix-list))
- (delete-region (point)
- (progn
- (forward-line 1)
- (point)))))
- (and (cdr section-list)
- (error
- "Too many top-of-fold marks -- reached end of file prematurely"))
- (goto-char (point-min))
- (buffer-enable-undo)
- (set-buffer-modified-p nil)
- (message "All folds reformatted.")))
-
-;;}}}
-;;}}}
-
-;;{{{ code: Standard fold marks for various major modes
-
-;;{{{ A function to set default marks, `folding-add-to-marks-list'
-
-(defun folding-add-to-marks-list (mode top bottom
- &optional secondary noforce message)
- "Add/set fold mark list for a particular major mode.
-When called interactively, asks for a `major-mode' name, and for
-fold marks to be used in that mode. It adds the new set to
-`folding-mode-marks-alist', and if the mode name is the same as the current
-major mode for the current buffer, the marks in use are also changed.
-
-If called non-interactively, arguments are MODE, TOP, BOTTOM and
-SECONDARY. MODE is the symbol for the major mode for which marks are
-being set. TOP, BOTTOM and SECONDARY are strings, the three fold marks
-to be used. SECONDARY may be nil (as opposed to the empty string), but
-the other two must be non-empty strings, and is an optional argument.
-
-Two other optional arguments are NOFORCE, meaning do not change the
-marks if marks are already set for the specified mode if non-nil, and
-MESSAGE, which causes a message to be displayed if it is non-nil. This
-is also the message displayed if the function is called interactively.
-
-To set default fold marks for a particular mode, put something like the
-following in your .emacs:
-
-\(folding-add-to-marks-list 'major-mode \"(** {{{ \" \"(** }}} **)\" \" **)\")
-
-Look at the variable `folding-mode-marks-alist' to see what default settings
-already apply.
-
-`folding-set-marks' can be used to set the fold marks in use in the current
-buffer without affecting the default value for a particular mode."
- (interactive
- (let* ((mode (completing-read
- (concat "Add fold marks for major mode ("
- (symbol-name major-mode)
- "): ")
- obarray
- (function
- (lambda (arg)
- (and (commandp arg)
- (string-match "-mode\\'"
- (symbol-name arg)))))
- t))
- (mode (if (equal mode "")
- major-mode
- (intern mode)))
- (object (assq mode folding-mode-marks-alist))
- (old-top (and object
- (nth 1 object)))
- top
- (old-bottom (and object
- (nth 2 object)))
- bottom
- (secondary (and object
- (nth 3 object)))
- (prompt "Top fold marker: "))
- (and (equal secondary "")
- (setq secondary nil))
- (while (not top)
- (setq top (read-string prompt (or old-top "{{{ ")))
- (and (equal top "")
- (setq top nil)))
- (setq prompt (concat prompt
- top
- ", Bottom marker: "))
- (while (not bottom)
- (setq bottom (read-string prompt (or old-bottom "}}}")))
- (and (equal bottom "")
- (setq bottom nil)))
- (setq prompt (concat prompt
- bottom
- (if secondary
- ", Secondary marker: "
- ", Secondary marker (none): "))
- secondary (read-string prompt secondary))
- (and (equal secondary "")
- (setq secondary nil))
- (list mode top bottom secondary nil t)))
- (let ((object (assq mode folding-mode-marks-alist)))
- (if (and object
- noforce
- message)
- (message "Fold markers for `%s' are already set."
- (symbol-name mode))
- (if object
- (or noforce
- (setcdr object (if secondary
- (list top bottom secondary)
- (list top bottom))))
- (setq folding-mode-marks-alist
- (cons (if secondary
- (list mode top bottom secondary)
- (list mode top bottom))
- folding-mode-marks-alist)))
- (and message
- (message "Set fold marks for `%s' to \"%s\" and \"%s\"."
- (symbol-name mode)
- (if secondary
- (concat top "name" secondary)
- (concat top "name"))
- bottom)
- (and (eq major-mode mode)
- (folding-set-marks top bottom secondary))))))
-
-;;}}}
-;;{{{ Set some useful default fold marks
-
-(folding-add-to-marks-list 'ada-mode "-- {{{" "-- }}}" nil t)
-(folding-add-to-marks-list 'asm-mode "; {{{" "; }}}" nil t)
-(folding-add-to-marks-list 'awk-mode "# {{{" "# }}}" nil t)
-(folding-add-to-marks-list 'Bison-mode "/* {{{" "/* }}} */" " */" t)
-(folding-add-to-marks-list 'LaTeX-mode "%{{{" "%}}}" nil t)
-(folding-add-to-marks-list 'TeX-mode "%{{{" "%}}}" nil t)
-(folding-add-to-marks-list 'bibtex-mode "%{{{" "%}}} */" nil t)
-(folding-add-to-marks-list 'bison-mode "/* {{{" "/* }}} */" " */" t)
-(folding-add-to-marks-list 'c++-mode "// {{{" "// }}}" nil t)
-(folding-add-to-marks-list 'c-mode "/* {{{" "/* }}} */" " */" t)
-(folding-add-to-marks-list 'dcl-mode "! {{{" "! }}}" nil t)
-(folding-add-to-marks-list 'change-log-mode "{{{" "}}}" nil t)
-(folding-add-to-marks-list 'cperl-mode "# {{{" "# }}}" nil t)
-(folding-add-to-marks-list 'emacs-lisp-mode ";;{{{" ";;}}}" nil t)
-(folding-add-to-marks-list 'erlang-mode "%%{{{" "%%}}}" nil t)
-(folding-add-to-marks-list 'finder-mode "{{{" "}}}" nil t)
-(folding-add-to-marks-list 'fortran-mode "! {{{" "! }}}" nil t)
-(folding-add-to-marks-list 'f90-mode "! {{{" "! }}}" nil t)
-(folding-add-to-marks-list 'generic-mode ";# " ";\$" nil t)
-(folding-add-to-marks-list 'gofer-mode "-- {{{" "-- }}}" nil t)
-(folding-add-to-marks-list 'html-mode "<!-- {{{ " "<!-- }}} -->" " -->" t)
-(folding-add-to-marks-list 'icon-mode "# {{{" "# }}}" nil t)
-(folding-add-to-marks-list 'indented-text-mode "{{{" "}}}" nil t)
-(folding-add-to-marks-list 'java-mode "// {{{" "// }}}" nil t)
-(folding-add-to-marks-list 'javascript-mode "// {{{" "// }}}" nil t)
-(folding-add-to-marks-list 'jde-mode "// {{{" "// }}}" nil t)
-(folding-add-to-marks-list 'ksh-mode "# {{{" "# }}}" nil t)
-(folding-add-to-marks-list 'latex-mode "%{{{" "%}}}" nil t)
-(folding-add-to-marks-list 'lisp-interaction-mode ";;{{{" ";;}}}" nil t)
-(folding-add-to-marks-list 'lisp-mode ";;{{{" ";;}}}" nil t)
-(folding-add-to-marks-list 'm4-mode "# {{{" "# }}}" nil t)
-(folding-add-to-marks-list 'makefile-mode "# {{{" "# }}}" nil t)
-(folding-add-to-marks-list 'matlab-mode "%%%{{{" "%%%}}}" nil t)
-(folding-add-to-marks-list 'meta-mode "% {{{" "% }}}" nil t)
-(folding-add-to-marks-list 'ml-mode "(* {{{" "(* }}} *)" " *)" t)
-(folding-add-to-marks-list 'modula-2-mode "(* {{{" "(* }}} *)" " *)" t)
-(folding-add-to-marks-list 'nroff-mode "\\\\ {{{" "\\\\ }}}" nil t)
-(folding-add-to-marks-list 'occam-mode "-- {{{" "-- }}}" nil t)
-(folding-add-to-marks-list 'orwell-mode "{{{" "}}}" nil t)
-(folding-add-to-marks-list 'pascal-mode "{ ((( " "{ ))) }" " }" t)
-(folding-add-to-marks-list 'php-mode "// {{{" "// }}}" nil t)
-(folding-add-to-marks-list 'perl-mode "# {{{" "# }}}" nil t)
-(folding-add-to-marks-list 'plain-TeX-mode "%{{{" "%}}}" nil t)
-(folding-add-to-marks-list 'plain-tex-mode "%{{{" "%}}}" nil t)
-(folding-add-to-marks-list 'prolog-mode "% {{{" "% }}}" nil t)
-(folding-add-to-marks-list 'python-mode "# {{{" "# }}}" nil t)
-(folding-add-to-marks-list 'rexx-mode "/* {{{" "/* }}} */" " */" t)
-(folding-add-to-marks-list 'sh-mode "# {{{" "# }}}" nil t)
-(folding-add-to-marks-list 'sh-script-mode "# {{{" "# }}}" nil t)
-(folding-add-to-marks-list 'shellscript-mode "# {{{" "# }}}" nil t)
-(folding-add-to-marks-list 'sgml-mode "<!-- [[[ " "<!-- ]]] -->" " -->" t)
-(folding-add-to-marks-list 'simula-mode "! {{{" "! }}}" nil t)
-(folding-add-to-marks-list 'sml-mode "(* {{{" "(* }}} *)" " *)" t)
-(folding-add-to-marks-list 'sql-mode "-- {{{" "-- }}}" nil t)
-(folding-add-to-marks-list 'tcl-mode "#{{{" "#}}}" nil t)
-(folding-add-to-marks-list 'tex-mode "%{{{" "%}}}" nil t)
-(folding-add-to-marks-list 'texinfo-mode "@c {{{" "@c {{{endfold}}}" " }}}" t)
-(folding-add-to-marks-list 'text-mode "{{{" "}}}" nil t)
-(folding-add-to-marks-list 'vhdl-mode "# {{{" "# }}}" nil t)
-(folding-add-to-marks-list 'xerl-mode "%%{{{" "%%}}}" nil t)
-(folding-add-to-marks-list 'xrdb-mode "! {{{" "! }}}" nil t)
-
-;; heavy shell-perl-awk programmer in fundamental-mode need # prefix...
-
-(folding-add-to-marks-list 'fundamental-mode "# {{{" "# }}}" nil t)
-
-;;}}}
-
-;;}}}
-
-;;{{{ code: Gross, crufty hacks that seem necessary
-
-;; ----------------------------------------------------------------------
-;; The functions here have been tested with Emacs 18.55, Emacs 18.58,
-;; Epoch 4.0p2 (based on Emacs 18.58) and XEmacs 19.6.
-
-;; Note that XEmacs 19.6 can't do selective-display, and its
-;; "invisible extents" don't work either, so Folding mode just won't
-;; work with that version.
-
-;; They shouldn't do the wrong thing with later versions of Emacs, but
-;; they might not have the special effects either. They may appear to
-;; be excessive; that is not the case. All of the peculiar things these
-;; functions do is done to avoid some side-effect of Emacs' internal
-;; logic that I have met. Some of them work around bugs or unfortunate
-;; (lack of) features in Emacs. In most cases, it would be better to
-;; move this into the Emacs C code.
-
-;; Folding mode is designed to be simple to cooperate with as many
-;; things as possible. These functions go against that principle at the
-;; coding level, but make life for the user bearable.
-
-;;{{{ folding-subst-regions
-
-;; Substitute newlines for carriage returns or vice versa.
-;; Avoid excessive file locking.
-
-;; Substitutes characters in the buffer, even in a read-only buffer.
-;; Takes LIST, a list of regions specified as sequence in the form
-;; (START1 END1 START2 END2 ...). In every region specified by each
-;; pair, substitutes each occurence of character FIND by REPLACE.
-
-;; The buffer-modified flag is not affected, undo information is not
-;; kept for the change, and the function works on read-only files. This
-;; function is much more efficient called with a long sequence than
-;; called for each region in the sequence.
-
-;; If the buffer is not modified when the function is called, the
-;; modified-flag is set before performing all the substitutions, and
-;; locking is temporarily disabled. This prevents Emacs from trying to
-;; make then delete a lock file for *every* substitution, which slows
-;; folding considerably, especially on a slow networked filesystem.
-;; Without this, on my system, folding files on startup (and reading
-;; other peoples' folded files) takes about five times longer. Emacs
-;; still locks the file once for this call under those circumstances; I
-;; can't think of a way around that, but it isn't really a problem.
-
-;; I consider these problems to be a bug in `subst-char-in-region'.
-
-(defun folding-subst-regions (list find replace)
- "Substitute \\r and \\n using LIST FIND REPLACE."
- (let ((buffer-read-only buffer-read-only) ;; Protect read-only flag.
- (modified (buffer-modified-p))
- (font-lock-mode nil)
- (lazy-lock-mode nil)
- (overlay-p (folding-use-overlays-p))
- (ask1 (symbol-function 'ask-user-about-supersession-threat))
- (ask2 (symbol-function 'ask-user-about-lock)))
- (if lazy-lock-mode ;; no-op: Byte compiler silencer
- (setq lazy-lock-mode t))
- (unwind-protect
- (progn
- (setq buffer-read-only nil)
- (or modified
- (progn
- (fset 'ask-user-about-supersession-threat
- '(lambda (&rest x) nil))
- (fset 'ask-user-about-lock
- '(lambda (&rest x) nil))
- (set-buffer-modified-p t))) ; Prevent file locking in the loop
- (while list
- (if overlay-p
- (folding-flag-region (car list) (nth 1 list) (eq find ?\n))
- (subst-char-in-region (car list) (nth 1 list) find replace t))
- (setq list (cdr (cdr list)))))
- ;; buffer-read-only is restored by the let.
- ;; Don't want to change MODIFF time if it was modified before.
- (or modified
- (unwind-protect
- (set-buffer-modified-p nil)
- (fset 'ask-user-about-supersession-threat ask1)
- (fset 'ask-user-about-lock ask2))))))
-
-;;}}}
-;;{{{ folding-narrow-to-region
-
-;; Narrow to region, without surprising displays.
-
-;; Similar to `narrow-to-region', but also adjusts window-start to be
-;; the start of the narrowed region. If an optional argument CENTRE is
-;; non-nil, the window-start is positioned to leave the point at the
-;; centre of the window, like `recenter'. START may be nil, in which
-;; case the function acts more like `widen'.
-
-;; Actually, all the window-starts for every window displaying the
-;; buffer, as well as the last_window_start for the buffer are set. The
-;; points in every window are set to the point in the current buffer.
-;; All this logic is necessary to prevent the display getting really
-;; weird occasionally, even if there is only one window. Try making
-;; this function like normal `narrow-to-region' with a touch of
-;; `recenter', then moving around lots of folds in a buffer displayed in
-;; several windows. You'll see what I mean.
-
-;; last_window_start is set by making sure that the selected window is
-;; displaying the current buffer, then setting the window-start, then
-;; making the selected window display another buffer (which sets
-;; last_window_start), then setting the selected window to redisplay the
-;; buffer it displayed originally.
-
-;; Note that whenever window-start is set, the point cannot be moved
-;; outside the displayed area until after a proper redisplay. If this
-;; is possible, centre the display on the point.
-
-;; In Emacs 19; Epoch or XEmacs, searches all screens for all
-;; windows. In Emacs 19, they are called "frames".
-
-(defun folding-narrow-to-region (&optional start end centre)
- "Narrow to region START END, possibly CENTRE."
- (let* ((the-window (selected-window))
- (selected-buffer (window-buffer the-window))
- (window-ring the-window)
- (window the-window)
- (point (point))
- (buffer (current-buffer))
- temp)
- (unwind-protect
- (progn
- (unwind-protect
- (progn
- (if (folding-use-overlays-p)
- (if start
- (folding-narrow-aux start end t)
- (folding-narrow-aux nil nil nil))
- (if start
- (narrow-to-region start end)
- (widen)))
-
- (setq point (point))
- (set-window-buffer window buffer)
-
- (while (progn
- (and (eq buffer (window-buffer window))
- (if centre
- (progn
- (select-window window)
- (goto-char point)
- (vertical-motion
- (- (lsh (window-height window) -1)))
- (set-window-start window (point))
- (set-window-point window point))
- (set-window-start window (or start 1))
- (set-window-point window point)))
-
- (not (eq (setq window (next-window window nil t))
- window-ring)))))
- nil ;; epoch screen
- (select-window the-window)) ;; unwind-protect INNER
- ;; Set last_window_start.
- (unwind-protect
- (if (not (eq buffer selected-buffer))
- (set-window-buffer the-window selected-buffer)
- (if (get-buffer "*scratch*")
- (set-window-buffer the-window (get-buffer "*scratch*"))
- (set-window-buffer
- the-window (setq temp (generate-new-buffer " *temp*"))))
- (set-window-buffer the-window buffer))
- (and temp
- (kill-buffer temp))))
- ;; Undo this side-effect of set-window-buffer.
- (set-buffer buffer)
- (goto-char (point)))))
-
-;;}}}
-
-;;}}}
-
-;;{{{ code: folding-end-mode-quickly
-
-(defun folding-end-mode-quickly ()
- "Replace all ^M's with linefeeds and widen a folded buffer.
-Only has any effect if Folding mode is active.
-
-This should not in general be used for anything. It is used when changing
-major modes, by being placed in kill-mode-tidy-alist, to tidy the buffer
-slightly. It is similar to `(folding-mode 0)', except that it does not
-restore saved keymaps etc. Repeat: Do not use this function. Its
-behaviour is liable to change."
- (and (boundp 'folding-mode)
- (assq 'folding-mode
- (buffer-local-variables))
- folding-mode
- (progn
- (if (folding-use-overlays-p)
- (folding-narrow-to-region nil nil)
- (widen))
- (folding-clear-stack)
- (folding-subst-regions (list 1 (point-max)) ?\r ?\n))))
-
-;;{{{ folding-eval-current-buffer-open-folds
-
-(defun folding-eval-current-buffer-open-folds (&optional printflag)
- "Evaluate all of a folded buffer as Lisp code.
-Unlike `eval-current-buffer', this function will evaluate all of a
-buffer, even if it is folded. It will also work correctly on non-folded
-buffers, so is a good candidate for being bound to a key if you program
-in Emacs-Lisp.
-
-It works by making a copy of the current buffer in another buffer,
-unfolding it and evaluating it. It then deletes the copy.
-
-Programs can pass argument PRINTFLAG which controls printing of output:
-nil means discard it; anything else is stream for print."
- (interactive)
- (if (or (and (boundp 'folding-mode)
- folding-mode))
- (let ((temp-buffer
- (generate-new-buffer (buffer-name))))
- (message "Evaluating unfolded buffer...")
- (save-restriction
- (widen)
- (copy-to-buffer temp-buffer 1 (point-max)))
- (set-buffer temp-buffer)
- (subst-char-in-region 1 (point-max) ?\r ?\n)
- (let ((real-message-def (symbol-function 'message))
- (suppress-eval-message))
- (fset 'message
- (function
- (lambda (&rest args)
- (setq suppress-eval-message t)
- (fset 'message real-message-def)
- (apply 'message args))))
- (unwind-protect
- (eval-current-buffer printflag)
- (fset 'message real-message-def)
- (kill-buffer temp-buffer))
- (or suppress-eval-message
- (message "Evaluating unfolded buffer... Done"))))
- (eval-current-buffer printflag)))
-
-;;}}}
-
-;;}}}
-
-;;{{{ code: ISearch support, walks in and out of folds
-
-;; This used to be a package of it's own.
-;; Requires Emacs 19 or XEmacs. Does not work under Emacs 18.
-
-;;{{{ Variables
-
-(defcustom folding-isearch-install t
- "*When non-nil, the isearch commands will handle folds."
- :type 'boolean
- :group 'folding)
-
-(defvar folding-isearch-stack nil
- "Temporary storage for `folding-stack' during isearch.")
-
-;; Lists of isearch commands to replace
-
-;; These do normal searching.
-
-(defvar folding-isearch-normal-cmds
- '(isearch-repeat-forward
- isearch-repeat-backward
- isearch-toggle-regexp
- isearch-toggle-case-fold
- isearch-delete-char
- isearch-abort
- isearch-quote-char
- isearch-other-control-char
- isearch-other-meta-char
- isearch-return-char
- isearch-exit
- isearch-printing-char
- isearch-whitespace-chars
- isearch-yank-word
- isearch-yank-line
- isearch-yank-kill
- isearch-*-char
- isearch-\|-char
- isearch-mode-help
- isearch-yank-x-selection
- isearch-yank-x-clipboard)
- "List if isearch commands doing normal search.")
-
-;; Enables the user to edit the search string
-
-;; Missing, present in XEmacs isearch-mode.el. Not necessary?
-;; isearch-ring-advance-edit, isearch-ring-retreat-edit, isearch-complete-edit
-;; isearch-nonincremental-exit-minibuffer, isearch-yank-x-selection,
-;; isearch-yank-x-clipboard
-
-(defvar folding-isearch-edit-enter-cmds
- '(isearch-edit-string
- isearch-ring-advance
- isearch-ring-retreat
- isearch-complete) ; (Could also stay in search mode!)
- "List of isearch commands which enters search string edit.")
-
-;; Continues searching after editing.
-
-(defvar folding-isearch-edit-exit-cmds
- '(isearch-forward-exit-minibuffer ; Exits edit
- isearch-reverse-exit-minibuffer
- isearch-nonincremental-exit-minibuffer)
- "List of isearch commands which exits search string edit.")
-
-;;}}}
-;;{{{ Keymaps (an Isearch hook)
-
-(defvar folding-isearch-mode-map nil
- "Modified copy of the isearch keymap.")
-
-;; Create local copies of the keymaps. The `isearch-mode-map' is
-;; copied to `folding-isearch-mode-map' while `minibuffer-local-isearch-map'
-;; is made local. (Its name is used explicitly.)
-;;
-;; Note: This is called every time the search is started.
-
-(defun folding-isearch-hook-function ()
- "Update the isearch keymaps for usage with folding mode."
- (if (and (boundp 'folding-mode) folding-mode)
- (let ((cmds (append folding-isearch-normal-cmds
- folding-isearch-edit-enter-cmds
- folding-isearch-edit-exit-cmds)))
- (setq folding-isearch-mode-map (copy-keymap isearch-mode-map))
- (make-local-variable 'minibuffer-local-isearch-map)
- ;; Make sure the destructive operations below doesn't alter
- ;; the global instance of the map.
- (setq minibuffer-local-isearch-map
- (copy-keymap minibuffer-local-isearch-map))
- (setq folding-isearch-stack folding-stack)
- (while cmds
- (substitute-key-definition
- (car cmds)
- (intern (concat "folding-" (symbol-name (car cmds))))
- folding-isearch-mode-map)
- (substitute-key-definition
- (car cmds)
- (intern (concat "folding-" (symbol-name (car cmds))))
- minibuffer-local-isearch-map)
- (setq cmds (cdr cmds)))
- ;; Install our keymap
- (cond
- (folding-xemacs-p
- (let ((f 'set-keymap-name))
- (funcall f folding-isearch-mode-map 'folding-isearch-mode-map))
- ;; Later version of XEmacs (21.2+) use overriding-local-map
- ;; for isearch keymap rather than fiddling with
- ;; minor-mode-map-alist. This is so isearch keymaps take
- ;; precedence over extent-local keymaps. We will support
- ;; both ways here. Keymaps will be restored as side-effect
- ;; of isearch-abort and isearch-quit
- (cond
- ;; if overriding-local-map is in use
- ((and (boundp 'overriding-local-map) overriding-local-map)
- (set-keymap-parent folding-isearch-mode-map overriding-local-map)
- (setq overriding-local-map folding-isearch-mode-map))
- ;; otherwise fiddle with minor-mode-map-alist
- (t
- (setq minor-mode-map-alist
- (cons (cons 'isearch-mode folding-isearch-mode-map)
- (delq (assoc 'isearch-mode minor-mode-map-alist)
- minor-mode-map-alist))))))
- ((boundp 'overriding-terminal-local-map)
- (funcall (symbol-function 'set)
- 'overriding-terminal-local-map folding-isearch-mode-map))
- ((boundp 'overriding-local-map)
- (setq overriding-local-map folding-isearch-mode-map))))))
-
-;; Undoes the `folding-isearch-hook-function' function.
-
-(defun folding-isearch-end-hook-function ()
- "Actions to perform at the end of isearch in folding mode."
- (when (and (boundp 'folding-mode) folding-mode)
- (kill-local-variable 'minibuffer-local-isearch-map)
- (setq folding-stack folding-isearch-stack)))
-
-(when folding-isearch-install
- (add-hook 'isearch-mode-hook 'folding-isearch-hook-function)
- (add-hook 'isearch-mode-end-hook 'folding-isearch-end-hook-function))
-
-;;}}}
-;;{{{ Normal search routines
-
-;; Generate the replacement functions of the form:
-;; (defun folding-isearch-repeat-forward ()
-;; (interactive)
-;; (folding-isearch-general 'isearch-repeat-forward))
-
-(let ((cmds folding-isearch-normal-cmds))
- (while cmds
- (eval
- `(defun ,(intern (concat "folding-" (symbol-name (car cmds))))
- nil
- "Automatically generated"
- (interactive)
- (folding-isearch-general (quote ,(car cmds)))))
- (setq cmds (cdr cmds))))
-
-;; The HEART! Executes command and updates the foldings.
-;; This is capable of detecting a `quit'.
-
-(defun folding-isearch-general (function)
- "Execute isearch command FUNCTION and adjusts the folding."
- (let* ((quit-isearch nil)
- (area-beg (point-min))
- (area-end (point-max))
- pos)
- (cond
- (t
- (save-restriction
- (widen)
- (condition-case nil
- (funcall function)
- (quit (setq quit-isearch t)))
- (setq pos (point)))
- ;; Situation
- ;; o user has folded buffer
- ;; o He manually narrows, say to function !
- ;; --> there is no fold marks at the beg/end --> this is not a fold
- (condition-case nil
- ;; "current mode has no fold marks..."
- (folding-region-has-folding-marks-p area-beg area-end)
- (error (setq quit-isearch t)))
- (folding-goto-char pos)))
- (if quit-isearch
- (signal 'quit '(isearch)))))
-
-;;}}}
-;;{{{ Edit search string support
-
-(defvar folding-isearch-current-buffer nil
- "The buffer we are editing, so we can widen it when in minibuffer.")
-
-;; Functions which enters edit mode.
-
-(defun folding-isearch-edit-string ()
- "Replace `isearch-edit-string' when in `folding-mode'."
- (interactive)
- (folding-isearch-start-edit 'isearch-edit-string))
-
-(defun folding-isearch-ring-advance ()
- "Replace `isearch-ring-advance' when in `folding-mode'."
- (interactive)
- (folding-isearch-start-edit 'isearch-ring-advance))
-
-(defun folding-isearch-ring-retreat ()
- "Replace `isearch-ring-retreat' when in `folding-mode'."
- (interactive)
- (folding-isearch-start-edit 'isearch-ring-retreat))
-
-(defun folding-isearch-complete ()
- "Replace `isearch-complete' when in `folding-mode'."
- (interactive)
- (folding-isearch-start-edit 'isearch-complete))
-
-;; Start and wait for editing. When (funcall fnk) returns
-;; we are back in interactive search mode.
-;;
-;; Store match data!
-
-(defun folding-isearch-start-edit (function)
- "Edit with function FUNCTION."
- (let (pos)
- (setq folding-isearch-current-buffer (current-buffer))
- (save-restriction
- (funcall function)
- ;; Here, we are widened, by folding-isearch-*-exit-minibuffer.
- (setq pos (point)))
- (folding-goto-char pos)))
-
-;; Functions which exits edit mode.
-
-;; The `widen' below will be caught by the `save-restriction' above, thus
-;; this will not cripple `folding-stack'.
-
-(defun folding-isearch-forward-exit-minibuffer ()
- "Replace `isearch-forward-exit-minibuffer' when in `folding-mode'."
- (interactive)
- ;; Make sure we can continue searching outside narrowing.
- (save-excursion
- (set-buffer folding-isearch-current-buffer)
- (widen))
- (isearch-forward-exit-minibuffer))
-
-(defun folding-isearch-reverse-exit-minibuffer ()
- "Replace `isearch-reverse-exit-minibuffer' when in `folding-mode'."
- (interactive)
- ;; Make sure we can continue searching outside narrowing.
- (save-excursion
- (set-buffer folding-isearch-current-buffer)
- (widen))
- (isearch-reverse-exit-minibuffer))
-
-(defun folding-isearch-nonincremental-exit-minibuffer ()
- "Replace `isearch-reverse-exit-minibuffer' when in `folding-mode'."
- (interactive)
- ;; Make sure we can continue searching outside narrowing.
- (save-excursion
- (set-buffer folding-isearch-current-buffer)
- (widen))
- (isearch-nonincremental-exit-minibuffer))
-
-;;}}}
-;;{{{ Special XEmacs support
-
-;; In XEmacs, all isearch commands must have the property `isearch-command'.
-
-(if folding-xemacs-p
- (let ((cmds (append folding-isearch-normal-cmds
- folding-isearch-edit-enter-cmds
- folding-isearch-edit-exit-cmds)))
- (while cmds
- (put (intern (concat "folding-" (symbol-name (car cmds))))
- 'isearch-command t)
- (setq cmds (cdr cmds)))))
-
-;;}}}
-;;{{{ General purpose function.
-
-(defun folding-goto-char (pos)
- "Goto character POS, changing fold if necessary."
- ;; Make sure POS is inside the visible area of the buffer.
- (goto-char pos)
- (if (eq pos (point)) ; Point inside narrowed area?
- nil
- (folding-show-all) ; Fold everything and goto top.
- (goto-char pos))
- ;; Enter if point is folded.
- (if (folding-point-folded-p pos)
- (progn
- (folding-shift-in) ; folding-shift-in can change the pos.
- (setq folding-isearch-stack folding-stack)
- (setq folding-stack '(folded))
- (goto-char pos))))
-
-(defun folding-point-folded-p (pos)
- "Non-nil when POS is not visible."
- (if (folding-use-overlays-p)
- (let ((overlays (overlays-at (point)))
- (found nil))
- (while (and (not found) (overlayp (car overlays)))
- (setq found (overlay-get (car overlays) 'fold)
- overlays (cdr overlays)))
- found)
- (save-excursion
- (goto-char pos)
- (beginning-of-line)
- (skip-chars-forward "^\r" pos)
- (not (eq pos (point))))))
-
-;;}}}
-
-;;}}}
-;;{{{ code: Additional functions
-
-(defvar folding-comment-folding-table
- '((c-mode
- folding-comment-c-mode
- folding-uncomment-c-mode))
- "Table of functions to comment and uncomment folds.
-Function is called with two arguments:
-
- number start of fold mark
- marker end of fold mark
-
-Function must return:
-
- (beg . end) start of fold, end of fold
-
-Table Format:
- '((MAJOR-MODE COMMENT-FUNCTION UNCOMMENT-FUNCTION) ..)")
-
-(defun folding-insert-advertise-folding-mode ()
- "Insert Small text describing where to the get the folding at point.
-This may be useful 'banner' to inform other people why your code
-is formatted like it is and how to view it correctly."
- (interactive)
- (let* ((prefix "")
- (re (or comment-start-skip
- (and comment-start
- (concat "^[ \t]*" comment-start "+[ \t]*")))))
-
- (when re
- (save-excursion
- (beginning-of-line)
- (when (or (re-search-forward re nil t)
- (progn
- (goto-char (point-min))
- (re-search-forward re nil t)))
- (setq prefix (match-string 0)))))
-
- (beginning-of-line)
- (dolist (line
- (list
- "File layout controlled by Emacs folding.el available at: "
- folding-package-url-location))
- (insert "\n" prefix line))))
-
-(defun folding-uncomment-mode-generic (beg end tag)
- "In region (BEG . END) remove two TAG lines."
- (re-search-forward tag (marker-position end))
- (beginning-of-line)
- (kill-line 1)
- (re-search-forward tag (marker-position end))
- (beginning-of-line)
- (kill-line 1)
- (cons beg end))
-
-(defun folding-comment-mode-generic (beg end tag1 &optional tag2)
- "Return (BEG . END) and Add two TAG1 and TAG2 lines."
- (insert tag1)
- (goto-char (marker-position end))
- (insert (or tag2 tag1))
- (cons beg end))
-
-(defun folding-uncomment-c-mode (beg end)
- "Uncomment region BEG END."
- (folding-uncomment-mode-generic
- beg end (regexp-quote " comment /* FOLDING -COM- */")))
-
-(defun folding-comment-c-mode (beg end)
- "Comment region BEG END."
- (let* ((tag " /* FOLDING -COM- */"))
- (folding-comment-mode-generic
- beg end
- (concat "#if comment" tag "\n")
- (concat "#endif comment" tag "\n"))))
-
-(defun folding-comment-fold (&optional uncomment)
- "Comment or UNCOMMENT all text inside single fold.
-If there are subfolds this function won't work as expected.
-User must know that there are no subfolds.
-
-The heading has -COM- at the end when the fold is commented.
-Point must be over fold heading {{{ when function is called.
-
-Note:
-
- You can use this function only in modes that do _not_ have
- `comment-end'. Ie. don't use this function in modes like C (/* */), because
- nested comments are not allowed. See this:
-
- /* {{{ fold */
- code /* comment of the code */
- /* }}} */
-
- Fold can't know how to comment the `code' inside fold, because comments
- do not nest.
-
-Implementation detail:
-
- {{{ FoldHeader-COM-
-
- If the fold header has -COM- at the end, then the fold is supposed to
- be commented. And if there is no -COM- then fold will be considered
- as normal fold. Do not loose or add the -COM- yourself or it will
- confuse the state of the fold.
-
-References:
-
- `folding-comment-folding-table'"
- (interactive "P")
- (let* ((state (folding-mark-look-at 'move))
- (closed (eq 0 state))
- (id "-COM-")
- (opoint (point))
- (mode-elt (assq major-mode folding-comment-folding-table))
- comment
- ret
- beg
- end)
- (unless mode-elt
- (if (stringp (nth 2 (folding-get-mode-marks major-mode)))
- (error "\
-Folding: function usage error, mode with `comment-end' is not supported.")))
- (when (or (null comment-start)
- (not (string-match "[^ \t\n]" comment-start)))
- (error "Empty comment-start."))
- (unless (memq state '( 0 1 11))
- (error "Incorrect fold state. Point must be over {{{."))
- ;; There is nothing to do if this fold heading does not have
- ;; the ID when uncommenting the fold.
- (setq state (looking-at (concat ".*" id)))
- (when (or (and uncomment state)
- (and (null uncomment) (null state)))
- (when closed (save-excursion (folding-show-current-entry)))
- (folding-pick-move) ;Go to end
- (beginning-of-line)
- (setq end (point-marker))
- (goto-char opoint) ;And off the fold heading
- (forward-line 1)
- (setq beg (point))
- (setq comment (concat comment-start id))
- (cond
- (mode-elt
- (setq ret
- (if uncomment
- (funcall (nth 2 mode-elt) (point) end)
- (funcall (nth 1 mode-elt) (point) end)))
- (goto-char (cdr ret)))
- (uncomment
- (while (< (point) (marker-position end))
- (if (looking-at comment)
- (delete-region (point) (match-end 0)))
- (forward-line 1)))
- (t
- (while (< (point) (marker-position end))
- (if (not (looking-at comment))
- (insert comment))
- (forward-line 1))))
- (setq end nil) ;kill marker
- ;; Remove the possible tag from the fold name line
- (goto-char opoint)
- (setq id (concat (or comment-start "") id (or comment-end "")))
- (if (re-search-forward (regexp-quote id) beg t)
- (delete-region (match-beginning 0) (match-end 0)))
- (when (null uncomment)
- (end-of-line)
- (insert id))
- (if closed
- (folding-hide-current-entry))
- (goto-char opoint))))
-
-(defun folding-convert-to-major-folds ()
- "Convert fold mark items according to `major-mode'.
-This function replaces all fold markings }}} and {{{
-with major mode's fold marks.
-
-As a side effect also corrects all foldings to standard notation.
-Eg. following, where correct folding-beg should be \"#{{{ \"
-Note that /// marks foldings.
-
- /// ;wrong fold
- # /// ;too many spaces, fold format error
- # ///title ;ok, but title too close
-
- produces
-
- #///
- #///
- #/// title
-
-You must 'unfold' whole buffer before using this function."
- (interactive)
- (let (case-fold-search
- (bm "{{{") ; begin match mark
- (em "}}}") ;
- el ; element
- b ; begin
- e ; end
- e2 ; end2
- pp)
- (catch 'out ; is folding active/loaded ??
- (unless (setq el (folding-get-mode-marks major-mode))
- (throw 'out t)) ; ** no mode found
- ;; ok , we're in business. Search whole buffer and replace.
- (setq b (elt el 0)
- e (elt el 1)
- e2 (or (elt el 2) ""))
- (save-excursion
- (goto-char (point-min)) ; start from the beginning of buffer
- (while (re-search-forward (regexp-quote bm) nil t)
- ;; set the end position for fold marker
- (setq pp (point))
- (beginning-of-line)
- (if (looking-at (regexp-quote b)) ; should be mode-marked; ok, ignore
- (goto-char pp) ; note that beg-of-l cmd, move rexp
- (delete-region (point) pp)
- (insert b)
- (when (not (string= "" e2))
- (unless (looking-at (concat ".*" (regexp-quote e2)))
- ;; replace with right fold mark
- (end-of-line)
- (insert e2)))))
- ;; handle end marks , identical func compared to prev.
- (goto-char (point-min))
- (while (re-search-forward (regexp-quote em)nil t)
- (setq pp (point))
- (beginning-of-line)
- (if (looking-at (regexp-quote e))
- (goto-char pp)
- (delete-region (point) (progn (end-of-line) (point)))
- (insert e)))))))
-
-(defun folding-all-comment-blocks-in-region (beg end)
- "Put all comments in folds inside BEG END.
-Notice: Make sure there is no interfering folds inside the area,
-because the results may and up corrupted.
-
-This only works for modes that DO NOT have `comment-end'.
-The `comment-start' must be left flushed in order to counted in.
-
-After this
-
- ;; comment
- ;; comment
-
- code
-
- ;; comment
- ;; comment
-
- code
-
-The result will be:
-
- ;; {{{ 1
-
- ;; comment
- ;; comment
-
- ;; }}}
-
- code
-
- ;; {{{ 2
-
- ;; comment
- ;; comment
-
- ;; }}}
-
- code"
- (interactive "*r")
-
- (unless comment-start
- (error "Folding: Mode does not define `comment-start'"))
-
- (when (and (stringp comment-end)
- (string-match "[^ \t]" comment-end))
- (error "Folding: Mode defines non-empty `comment-end'."))
- (let* ((count 0)
- (comment-regexp (concat "^" comment-start))
- (marker (point-marker))
- done)
- (destructuring-bind (left right ignore)
- (folding-get-mode-marks)
- ;; Bytecomp silencer: variable ignore bound but not referenced
- (if ignore (setq ignore ignore))
- ;; %%%{{{ --> "%%%"
- (string-match (concat (regexp-quote comment-start) "+") left)
- (save-excursion
- (goto-char beg)
- (beginning-of-line)
- (while (re-search-forward comment-regexp nil t)
- (move-marker marker (point))
- (setq done nil)
- (beginning-of-line)
- (forward-line -1)
- ;; 2 previous lines Must not contain FOLD beginning already
- (unless (looking-at (regexp-quote left))
- (forward-line -1)
- (unless (looking-at (regexp-quote left))
- (goto-char (marker-position marker))
- (beginning-of-line)
- (insert left " " (int-to-string count) "\n\n")
- (incf count)
- (setq done t)))
- (goto-char (marker-position marker))
- (when done
- ;; Try finding pat of the comment block
- (if (not (re-search-forward "^[ \t]*$" nil t))
- (goto-char end))
- (open-line 1)
- (forward-line 1)
- (insert right "\n")))))))
-
-;;}}}
-;;{{{ code: Overlay support
-
-(defun folding-use-overlays-p ()
- "Should folding use overlays?."
- (if folding-allow-overlays
- (if folding-xemacs-p
- ;; See if we can load overlay.el library that comes in 19.15
- ;; This call returns t or nil if load was successful
- ;; Note: is there provide statement? Load is so radical
- ;;
- (load "overlay" 'noerr)
- t)))
-
-(defun folding-flag-region (from to flag)
- "Hide or show lines from FROM to TO, according to FLAG.
-If FLAG is nil then text is shown, while if FLAG is t the text is hidden."
- (let ((inhibit-read-only t)
- overlay)
- (save-excursion
- (goto-char from)
- (end-of-line)
- (cond
- (flag
- (setq overlay (make-overlay (point) to))
- (folding-make-overlay-hidden overlay))
- (t
- (if (fboundp 'hs-discard-overlays)
- (funcall (symbol-function 'hs-discard-overlays)
- (point) to 'invisible t)))))))
-
-(defun folding-make-overlay-hidden (overlay)
- "Make OVERLAY hidden."
- (overlay-put overlay 'fold t)
- ;; (overlay-put overlay 'intangible t)
- (overlay-put overlay 'invisible t)
- (overlay-put overlay 'owner 'folding))
-
-(defun folding-narrow-aux (start end arg)
- "Narrow. Make overlay from `point-min' to START.
-And from END t `point-min'. If ARG is nil, delete overlays."
- (if (null arg)
- (cond
- (folding-narrow-overlays
- (delete-overlay (car folding-narrow-overlays))
- (delete-overlay (cdr folding-narrow-overlays))
- (setq folding-narrow-overlays nil)))
- (let ((overlay-beg (make-overlay (point-min) start))
- (overlay-end (make-overlay end (point-max))))
- (overlay-put overlay-beg 'folding-narrow t)
- (overlay-put overlay-beg 'invisible t)
- (overlay-put overlay-beg 'owner 'folding)
- (overlay-put overlay-end 'folding-narrow t)
- (overlay-put overlay-end 'invisible t)
- (overlay-put overlay-end 'owner 'folding)
- (setq folding-narrow-overlays (cons overlay-beg overlay-end)))))
-
-;;}}}
-;;{{{ code: end of file tag, provide
-
-(folding-install)
-
-(provide 'folding)
-(provide 'folding-isearch) ;; This used to be a separate package.
-
-(run-hooks 'folding-load-hook)
-
-;;}}}
-
-;;; folding.el ends here