5416 lines
210 KiB
EmacsLisp
5416 lines
210 KiB
EmacsLisp
;;; 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' <20>%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
|