;;; folding.el --- make Emacs into a folding editor

;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 2001, 2002, 2003 Jamie Lokier

;; Author: Jamie Lokier <jamie@shareable.org>
;; Maintainer: Jamie Lokier <jamie@shareable.org>
;; Keywords: tools, folding, outline
;; Version: 2.99.1

;; This file is intended to be used with GNU Emacs.  It is not part of
;; GNU Emacs, but is distributed under the same conditions.

;; 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; either version 2, or (at your option)
;; any later version.

;; This program 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 GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;; THIS VERSION HAS NOT BEEN PUBLICLY RELEASED.
;; Consider it to be in beta test.

;;; Commentary:

;;{{{ Introduction

;; Folding mode is a minor mode that makes Emacs into a folding editor.
;; Text can be organised into a hierarchy of "folded" regions.  By
;; hiding the text in folds, text can be abstracted to show different
;; levels of detail.  It is possible to "enter" folds, similar to
;; narrowing, to concentrate on the contents of a particular fold.  This
;; literally adds a whole new dimension to text, making it easier to
;; browse and edit large bodies of text.

;; Folding mode works as well with programming languages as it does with
;; normal text.  Typically a fold is provided around each function and
;; related groups of functions, to provide structure to a program's
;; source text.

;; The effect is similar to Outline mode, but unlike Outline mode, the
;; "fold marks" are the same regardless of their depth in the hierarchy.
;; This allows whole folds to be cut and pasted, without worrying about
;; their effect on the rest of the hierarchy.  There is also more
;; emphasis placed on entering and exiting; after a while, it can feel
;; as natural as cursor movement.

;; The remaining documentation is best read using Folding mode itself.

;;}}}
;;{{{ General information

;; This is version 2.99.1 of Folding mode, under development.

;; This file has been edited with a folding editor (itself! :-).

;; Send suggestions and/or bug fixes to "Jamie Lokier <jamie@shareable.org>".
;; If you can, please check the most recent version of Folding mode
;; before reporting bugs.

;;{{{ Archive information

;; This is ancient and may not apply any more.

;; LCD Archive Entry:
;; folding|Jamie Lokier|jamie.lokier@cern.ch|
;; A folding-editor-like minor mode|
;; $Date: 2002/08/09 01:32:34 $|$Revision: 1.6 $|~/modes/folding.el.Z|

;;}}}

;;}}}
;;{{{ Installation

;;{{{ Really basic installation

;; To install Folding mode, put this file (folding.el) somewhere where
;; Emacs will find it, byte-compile it with `M-x byte-compile-file', and
;; put the following in your .emacs:
;;
;; -----start here-----
;; (autoload 'folding-mode "folding"
;;  "Minor mode that simulates a folding editor" t)
;; ------end here------
;;
;; That's all you need to get started.  It is important that Folding
;; mode is byte-compiled, for speed reasons.  It will work, albeit
;; slowly, without being byte-compiled.  (Expect lots of warnings from
;; the byte-compiler about functions not known to be defined).
;;
;; The best way to learn how to use Folding mode after installing it is
;; to visit the source file, followed by `M-x folding-mode', and to try
;; moving in and out of folds.  Keys are documented under the function
;; `folding-mode', though you might want to customize them.  Keys in
;; Folding mode are bound in the keymap `folding-mode-map'.
;;
;; Brief documentation for Folding mode (what it is, how you use it) can
;; be called up with the key sequence `C-h f folding-mode'.

;;}}}
;;{{{ Slightly more sophisticated installation

;; To have Folding mode start automatically when visiting folded files,
;; add the following to your .emacs as well:
;;
;; -----start here-----
;; (defun folding-mode-find-file-hook ()
;;   "One of the hooks called whenever a `find-file' is successful."
;;   (and (assq 'folded-file (buffer-local-variables))
;;        folded-file
;;        (folding-mode 1)
;;        (kill-local-variable 'folded-file)))
;;
;; (or (memq 'folding-mode-find-file-hook find-file-hooks)
;;     (setq find-file-hooks (append find-file-hooks
;;                                   '(folding-mode-find-file-hook))))
;; ------end here------
;;
;; If you load folding.el all the time during startup, none of the above
;; is necessary; it can be replaced with something like this:
;;
;; -----start here-----
;; (load "folding")
;; (folding-mode-add-find-file-hook)
;; ------end here------
;;
;; Usually Folding mode will run fine even with non-folded files, so you
;; might like to call it all the time from `c-mode-hook' or
;; `text-mode-hook', for example.

;;}}}
;;{{{ Compiling: Hairier aspects of installation

;; When folding.el is byte-compiled, macros check to see what type of
;; Emacs it is being compiled on, and appropriate code is generated.
;; This is because there is quite a bit of variation between the four
;; main Emacs branches: FSF Emacs 18, FSF Emacs 19, Epoch and Lucid
;; Emacs, and folding.el has different ways of working with each of
;; them.

;; The problem is that the resulting folding.elc file will only work
;; with one type of Emacs.  Actually it is the available feature-set
;; which matters; folding.elc checks to see if the features it finds
;; when it is loaded are the same as the ones found when it was
;; compiled, and refuses to load if they are not.  This is to avoid
;; horrendously subtle bugs which would occur otherwise.

;; If you regularly use the same Emacs-Lisp files with different types
;; of Emacs, then this can be a nuisance.  The suggested workarounds are:
;;
;; (1) Have separate sub-directories containing lisp files for different
;;     types of Emacs, and put the different folding.elc files in the
;;     appropriate ones.
;;
;; (2) Name the byte-compiled files something like folding-18.elc,
;;     folding-19.elc, etc., and ensure the appropriate `autoload' call
;;     is reached in your .emacs or other startup files.

;;}}}

;;}}}
;;{{{ Customization

;;{{{ Changing the key bindings

;; You can rebind Folding mode keys with the keymap `folding-mode-map'.
;; If you bind any keys in this keymap before folding.el is loaded,
;; Folding mode will not bind any of its own (not even a menu will
;; appear (in FSF Emacs 19)).  So probably the best place to bind keys
;; is in `folding-mode-hook'.  As an example, here are some of the
;; bindings I use with FSF Emacs 19, under X11R5 with a Sun type-5
;; keyboard:
;;
;; (add-hook 'folding-mode-hook
;;	     (lambda ()
;;	       (define-key folding-mode-map [f27] 'fold-enter)
;;	       (define-key folding-mode-map [f29] 'fold-exit)
;;	       (define-key folding-mode-map [f33] 'fold-show)
;;	       (define-key folding-mode-map [f35] 'fold-hide)
;;	       (define-key folding-mode-map [left] 'fold-backward-char)
;;	       (define-key folding-mode-map [right] 'fold-forward-char)
;;	       (define-key folding-mode-map [?\M-g] 'fold-goto-line)))
;;
;; I highly recommend binding the `fold-enter' and `fold-exit' commands
;; to keys very near the cursor keys.  This is so that you don't have to
;; move your hand away from the cursors to reach those two basic keys.
;;
;; Old versions of Emacs (prior to 19)
;; ===================================
;;
;; In older versions of Emacs, rebinding keys in `folding-mode-map' does
;; not have an immediate effect if Folding mode is already running; it
;; is necessary to stop and restart Folding mode in the current buffer
;; for the new bindings to have any effect.  Similarly, calling
;; `local-set-key' while Folding mode is running may have unpredictable
;; results.

;;}}}
;;{{{ Changing the menu bindings

;; With FSF Emacs 19, a "Fold" menu is available.  The entries in this
;; menu can be changed by defining entries in the keymap
;; `folding-mode-menu-map'.  See the Emacs Lisp manual for details of
;; how defining entries in a keymap corresponds to menu entries.

;;}}}

;;}}}
;;{{{ Wrappers for standard commands

;; We provide versions of a number of useful Emacs functions, modified
;; so that they work properly with Folding mode.  The have the name of
;; their corresponding functions prefixed with the `fold-'.  These
;; functions will eventually become obsolete with some future version of
;; Emacs.
;;
;; The following wrapper commands are useful in Folding mode.  They are
;; good things to bind in `folding-mode-map' (some are bound by default):
;;
;; fold-forward-char
;; fold-backward-char
;; fold-goto-char
;; fold-goto-line
;;
;; The following commands are useful even outside Folding mode, because
;; they might involve switching the current buffer to a folded buffer,
;; which doesn't work with the standard commands.  The are good things
;; to bind in the global keymap.  If you do bind some of these commands
;; in the global keymap, and don't always load this file when you start
;; Emacs, you will probably want to provide autoload entries for them as
;; well, just like the function `folding-mode':
;; 
;; fold-next-error
;; fold-find-tag
;; fold-find-tag-other-window
;; fold-tags-search
;; fold-tags-query-replace
;; fold-tags-loop-continue
;;
;; Note:
;; `fold-next-error' will not work properly with the "compile.el" from
;; Emacs 18.57 or earlier.  If you are using such a version of Emacs,
;; try to get "compile.el" from a later version (but still version
;; 18.xx).  The change is a minor one.

;;}}}
;;{{{ Compatibility

;; Emacs 18
;; ========
;; Folding mode version 1.6.2 has been tested with versions 18.55 and
;; 18.58 of Emacs.  The current version should still work; if not, it is
;; a bug, so please report it.

;; Epoch
;; =====
;; Version 1.6.2 has been tested and seems to work with Epoch 4.0p2.

;; Lucid Emacs
;; ===========
;; I have had reports that Folding mode version 1.6.2 works fine with
;; Lucid Emacs 19.8.  It definitely won't work with Lucid Emacs 19.6.

;; Emacs 19
;; ========
;; Tested on GNU Emacs versions 19.16-19.18; appears to be fine.  As of
;; GNU Emacs 19.18, Folding mode uses text-properties instead of
;; selective-display to hide the text.  It also uses lots more of them
;; to control movement around folds.  Amongst other things this means
;; that folds can be automatically entered and exited as the point is
;; moved, and program indentation works correctly.

;;}}}
;;{{{ And the rest

;; There are is no real documentation yet; I haven't had time.  I intend
;; to write some one day, but I will refrain from predicting when.  Read
;; the documentation for the function `folding-mode' for the most useful
;; tips.

;; Major tip: Occasionally you exit a fold and the screen fills with a
;; column of `$' signs on the left.  If that happens, it will be because
;; you're accidentally typing `C-x <' instead of `C-c <'.  That's the
;; scroll-left command.  Typing `C-x >' gets the text back.

;;}}}
;;{{{ Known bugs

;; *** Needs fold-fold-region to be more intelligent about finding a
;; good region.  Check folding a whole current fold, or a region
;; containing unbalanced fold marks.

;; *** Check out what happens when you exit a fold with the file
;; displayed in two frames.  Both windows get fronted.  Better fix that
;; sometime.

;; *** fold-mode-marks-alist isn't documented correctly.

;; *** 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.

;; *** The section entitled ``Gross, crufty hacks that seem necessary''
;; is not a bug!  Well, not unless someone can demonstrate that it is
;; anyway.

;; Some isolated parts of the code are quite horrible, generally in
;; order to avoid some Emacs display "features".

;;}}}
;;{{{ To do

;; *** Fold titles should be optionally allowed on the closing fold
;; marks, and `fold-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 expect the variable to
;; change to `fold-marks' too.

;; *** General-purpose fold-descriptors, language-sensitive folding etc.

;; *** Finish text-properties support.  Decide if it should all be done
;; with properties, or maybe selective-display should still be used as
;; well.  The Emacs implementation of `invisible' needs work as it is
;; rather slow at the moment.

;; fold-tidy-inside does the wrong thing at the top level.

;;}}}

;;; Code:

;;{{{ Indentation

(put 'fold-cc 'lisp-indent-function 2)
(put 'fold-make-function 'lisp-indent-function 'defun)
(put 'fold-rebind-functions 'lisp-indent-function 1)
(put 'fold-subst-in-form 'lisp-indent-function 1)

;;}}}
;;{{{ Conditional compilation

;;{{{ Initial fragment of fold-big-defun

;;;;;;; Avoid putting bulky, unnecessary code into the compiled file, the fun way.

;;;;;(defmacro fold-pre-eval (a) (eval a))

;;;;;;; The rest of the file is enclosed in this function.  Don't indent-sexp
;;;;;;; this.  Can you believe jwz's byte-compiler version FSF 2.10 breaks if
;;;;;;; this is a normal defun?  Oh well.  We have a workaround at the
;;;;;;; end-fragment, take a look at that.

;;;;;(defun fold-big-defun ()
;;;;;  (fold-pre-eval
;;;;;   (let ((bodies '(
;;;;;() ; In first column to fool the indentation into being useful.

;;}}}

;; Suppress warning about a free-variable.
;; Not user-settable.
(defconst fold-emacs-features nil)

(defmacro defmacro-compile-only (&rest forms)
  (cons 'defmacro forms))

;;{{{ fold-check-emacs-features

;; Check to see what facilities this Emacs provides.  It is a macro
;; because it needs to be evaluated at compile time.  It is not inside
;; `fold-big-defun' because it is also evaluated at run time, and the
;; values are checked against those found at compile time.

;; Checks to see what type of Emacs we have, and which features it
;; provides.  This is used to control conditional compilation.  It is a
;; macro which expands to code which computes an alist.

;; At compile-time, the value is computed and assigned to
;; `fold-emacs-features'.  At run-time, the value is recomputed and
;; checked against the one computed at compile-time.  We bother checking
;; because the wrong conditionally- compiled bits can introduce subtle
;; bugs.

;; Naturally the existence of some features implies the existence of
;; others.

(defmacro-compile-only fold-check-emacs-features ()
  ''(let ((case-fold-search t) epoch lucid e19 buffer)
      ;; Lucid takes priority over Epoch.
      (save-excursion
	(unwind-protect
	    (progn
	      (set-buffer (setq buffer (generate-new-buffer " *test*")))
	      (cond ((string-match "lucid" emacs-version)
		     (setq lucid t))
		    ((and (boundp 'epoch::version) epoch::version)
		     (setq epoch t))
		    ;; Match all Emacs versions from 19 onwards :-).
		    ;; Some people have some non-numeric text before
		    ;; the number.
		    ((string-match
		      "\\`[^0-9]*\\(1\\(9\\|[0-9][0-9]\\)\\|[2-9][0-9]\\)"
		      emacs-version)
		     (setq e19 t)))
	      (list (cons 'epoch-screens
			  (and epoch (fboundp 'epoch::current-screen)))
		    (cons 'lucid-screens lucid)
		    (cons 'lucid-keymaps
			  (and lucid (fboundp 'set-keymap-parent)))
		    (cons 'emacs-frames (fboundp 'selected-frame))
		    (cons 'minor-mode-maps (boundp 'minor-mode-map-alist))
		    ;; Don't check for x-popup-menu any more, so that
		    ;; someone with emacs compiled both for X and without
		    ;; it can use the same compiled file--and someone
		    ;; might implement menus for terminals.
		    ;(and e19 (fboundp 'x-popup-menu)))
		    (cons 'menu-keymaps e19)
		    (cons 'crs t)	; Text parsing looks for ^Ms.
		    (cons 'text-properties
			  ;; The ones we want are available in 19.20 onwards.
			  ;; Actually, we'll disable them completely for now.
			  (and nil
			       e19
			       (fboundp 'add-text-properties)
			       (string-match "\
\\`[^0-9]*[0-9]+\\.\\(1[0-9][0-9]\\|[2-9][0-9]\\)" emacs-version)))
		    (cons 'buffer-disable-undo
			  (and e19 (fboundp 'buffer-disable-undo)))
		    (cons 'input-events (fboundp 'event-modifiers))
		    (cons 'marker-types (fboundp 'set-marker-type))
		    (cons 'count-lines-selective-display
			  ;; Does count-lines handle selective-display?
			  (and (not (fboundp 'fold-count-lines))
			       (set (make-local-variable 'selective-display) t)
			       (progn
				 (erase-buffer)
				 (insert "abc\C-m\C-m\C-mdef")
				 (eq 4 (count-lines 1 10)))
			       (progn
				 (erase-buffer)
				 ;; This is for the sake of 19.22, which
				 ;; tried to fix it but still got it wrong.
				 (insert "abc\C-m\C-m")
				 (eq 2 (count-lines 1 6))))) ))
	  (and buffer (kill-buffer buffer))))))

;;}}}
;;{{{ fold-verify-emacs-features

;; Check to see that the settings at run-time are the same as those at
;; compile-time.

(defmacro-compile-only fold-verify-emacs-features ()
  (setq fold-emacs-features (eval (fold-check-emacs-features)))
  (list 'let
	(list (list 'f (fold-check-emacs-features)))
	(list 'if
	      (list 'equal 'f (list 'quote fold-emacs-features))
	      (list 'setq 'fold-emacs-features 'f)
	      (list 'error "\
File \"folding.elc\" was compiled with a different Emacs; please recompile it.\
"))))

(fold-verify-emacs-features)

;;}}}
;;{{{ fold-cc

;; This macro isn't a `defmacro-compile-only' because we want the
;; definition to be included in the compiled file.

;; (fold-cc FEATURE YES &optional NO-FORMS).

;; At compile-time, the symbol FEATURE is looked up in the alist
;; `fold-emacs-features'.  If the corresponding value is non-nil, the
;; form YES is returned, otherwise all the NO-FORMS are returned, in a
;; `progn' is there is more that one.  If the symbol is not in the
;; alist, a compile-time error occurs.

;; This macro must be expanded at compile-time, because it is used
;; around some defuns, and the v18 compiler can't handle nested defuns.
;; `fold-big-defun' knows how to expand "top-level" macros like this, so
;; if one expands to a defun, that is fine.  If this macro doesn't
;; expand, the defun isn't "top-level", and even `fold-big-defun' won't
;; make it work properly.

(defmacro fold-cc (cond yes &rest nos)
  (if (let ((result (assq cond fold-emacs-features)))
	(if result
	    (cdr result)
	  (error "fold-cc: Unknown feature `%s'"
		 (symbol-name cond))))
      yes
    (and nos
	 (if (cdr nos)
	     (cons 'progn nos)
	   (car nos)))))

;;}}}

;;}}}

;;{{{ Menu: folding-mode-menu-map

;; Here is the pull-down menu we use, if menus are available.

(fold-cc menu-keymaps
    (defvar folding-mode-menu-map nil
      "Menu keymap used in Folding mode (a minor mode)."))

(fold-cc menu-keymaps
    (progn
      (if folding-mode-menu-map
	  nil
	(setq folding-mode-menu-map (make-sparse-keymap "Folding mode menu"))
	(fold-cc lucid-keymaps
	    (set-keymap-name folding-mode-menu-map 'folding-mode-menu-map))
	(mapcar (function
		 (lambda (obj)
		   (define-key folding-mode-menu-map (vector (nth 1 obj))
		     (cons (car obj) (nth 1 obj)))
		   (put (nth 1 obj) 'menu-enable (nth 2 obj))))
		(reverse ; Have the list in menu order.

		 ;; Actual menu entries, in menu order.

		 '(("Enter selected fold" fold-enter folding-mode)
		   ("Exit current fold"   fold-exit folding-mode)
		   ("Show selected fold"  fold-show folding-mode)
		   ("Hide selected fold"  fold-hide folding-mode)
		   ("Tidy current fold"   fold-tidy-inside folding-mode)
		   ("Fold region"         fold-fold-region folding-mode)
		   ("Exit to top level"   fold-top-level folding-mode)
		   ("Show whole buffer"   fold-open-buffer folding-mode)
		   ("Hide whole buffer"   fold-whole-buffer folding-mode)

		   ))))))

;;}}}
;;{{{ Keymap: folding-mode-map

(defvar folding-mode-map nil
  "Keymap used in Folding mode (a minor mode).")

(if folding-mode-map
    nil
  (setq folding-mode-map (make-sparse-keymap))
  (fold-cc lucid-keymaps
      (set-keymap-name folding-mode-map 'folding-mode-map))
  (mapcar
   (function (lambda (x) (apply 'define-key folding-mode-map x)))
   (append

    (fold-cc input-events

;;; Keys to be included if this Emacs supports input events.
;;; It is very hard to type `C-c >', so we bind `C-c C->' too.
;;; Older Emacs' think they are the same thing.

	'(([?\C-c ?\C->] fold-enter)
	  ([?\C-c ?\C-<] fold-exit)
	  ([C-S-right] fold-enter)
	  ([C-S-left] fold-exit)
	  ;; C-S-up/down will become fold-previous, fold-next.
	  ;; Is anyone using these keys for anything else?
	  ))

;;; Keys for all types of Emacs.

    '(("\C-c>" fold-enter)
      ("\C-c<" fold-exit)
      ("\C-c\C-t" fold-top-level)
      ("\C-c\C-f" fold-fold-region)
      ("\C-c\C-s" fold-show)
      ("\C-c\C-h" fold-hide)
      ("\C-c\C-o" fold-open-buffer)
      ("\C-c\C-w" fold-whole-buffer)
      ("\C-c\C-r" fold-remove-folds))

    (fold-cc text-properties
	nil

;;; Keys we only need when there's no text-properties.

      '(;;FIXME
	("\C-f" fold-forward-char)
	("\C-b" fold-backward-char)
	("\C-e" fold-end-of-line)
	))

;;; The entry that puts the "Fold" menu up.
;;; The menu itself is in `folding-mode-menu-map'.

    (fold-cc menu-keymaps
	(list
	 (list [menu-bar fold]
	       (cons "Fold" folding-mode-menu-map)))))))

;;}}}
;;{{{ Hooks and variables

;;{{{ folding-mode-hook

(defvar 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.")

;;}}}
;;{{{ fold-fold-on-startup

(defvar fold-fold-on-startup t
  "*If non-nil, buffers are folded when starting Folding mode.")

;;}}}
;;{{{ fold-mark-indentation-function

(defvar fold-mark-indentation-function t
  "*Initial indentation given to new fold marks.
nil means use no indentation.
An integer means use that much indentation.
t means use the indentation of the first non-blank line in the folded
region, ignoring comments.  Count fold marks as if they weren't comments.
If no such text found, but a comment was found, use that instead.  If
nothing found (all the text in the region is whitespace), use the
indentation of point.

Anything else is a function to call to compute the indentation.  The
function is given two integer arguments, START and END.  They denote the
region containing the text of the new fold (fold marks have not been
inserted at this stage).  It may examine the text in the buffer, but may
not change it (`buffer-read-only' is set temporarily to enforce this).
It should return the column to which the new fold marks will be
indented.

NOTE: The buffer may contain carriage-return characters which should be
treated as linefeed characters for the purpose of indentation checks.

t is the default value of this variable.

This variable is local to each buffer.  To set the default value for all
buffers, use `setq-default'.")

(make-variable-buffer-local 'fold-indentation-function)

;;}}}
;;{{{ fold-mark-balance-indentation

(defvar fold-tidy-mark-indentation t
  "*Non-nil means balance indentation of fold-marks when tidying.

If non-nil, `fold-tidy-inside' sets the indentation of the bottom fold
mark to be the same as that of the top one.

This variable is local to each buffer.  To set the default value for all
buffers, use `setq-default'.

See also `fold-tidy-inside'.")

;;}}}
;;{{{ fold-internal-margins

(defvar fold-internal-margins 1
  "*Number of blank lines left inside fold marks when tidying folds.

When exiting a fold, and at other times, `fold-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 is valid, meaning leave no
blank lines.

This variable is local to each buffer.  To set the default value for all
buffers, use `setq-default'.

See also `fold-tidy-inside'.")

(make-variable-buffer-local 'fold-internal-margins)

;;}}}
;;{{{ fold-mode-marks-alist

(defvar fold-mode-marks-alist nil
  "List of (major-mode . fold marks) 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 `fold-mode-marks-alist',
those marks are used by default.  If none are found, the default values
of \"{{{ \" and \"}}}\" are used.")

;;}}}

;;}}}
;;{{{ Start Folding mode, and documentation

;;{{{ fold-stack

;; 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 fold-stack nil
  "A list of marker pairs representing folds entered so far.")

;;}}}
;;{{{ fold-mode-string

(defvar fold-mode-string nil
  "Buffer-local variable that holds the fold depth description.")

(set-default 'fold-mode-string " Folding")

;;}}}

;;{{{ Add to minor-mode-alist

(or (assq 'folding-mode minor-mode-alist)
    (setq minor-mode-alist
	  (cons '(folding-mode fold-mode-string) minor-mode-alist)))

;;}}}
;;{{{ Add to minor-mode-map-alist

(fold-cc minor-mode-maps
    (or (assq 'folding-mode minor-mode-map-alist)
	(setq minor-mode-map-alist
	      (cons (cons 'folding-mode folding-mode-map)
		    minor-mode-map-alist))))

;;}}}

;;{{{ folding-mode the variable

(defvar folding-mode nil
  "Non-nil means Folding mode is active in the current buffer.")

(make-variable-buffer-local 'folding-mode)
(setq-default folding-mode nil)

;;}}}
;;{{{ folding-mode the function

;;;###autoload
(defun folding-mode (&optional arg inter)
  ;;{{{ Documentation

  "Turns Folding mode (a minor mode) on and off.

These are the basic commands that Folding mode provides:
\\<folding-mode-map>
fold-enter:	    `\\[fold-enter]'
     Enters the fold that the point is on.

fold-exit:	    `\\[fold-exit]'
     Exits the current fold.

fold-fold-region:   `\\[fold-fold-region]'
     Surrounds the region with a new fold.

fold-top-level:	    `\\[fold-top-level]'
     Exits all folds.

fold-show:	    `\\[fold-show]'
     Opens the fold that the point is on, but does not enter it.

fold-hide:	    `\\[fold-hide]'
     Closes the fold that the point is in, exiting it if necessary.

fold-whole-buffer:  `\\[fold-whole-buffer]'
     Folds the whole buffer.

fold-open-buffer:   `\\[fold-open-buffer]'
     Unfolds the whole buffer; good to do just before a search.

fold-remove-folds:  `\\[fold-remove-folds]'
     Makes a ready-to-print, formatted, unfolded copy in another buffer.

Read the documentation for the above functions for more information.

Folds are a way of hierarchically organising 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.).

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 `\\[fold-enter]'.  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 `\\[fold-exit]' 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 \"Folds:n\",
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.

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
`\\[fold-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, `fold-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 `\\[fold-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 `\\[fold-whole-buffer]' to fold the buffer again.

`fold-exit' 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).

You can make folded files start Folding mode automatically when they are
visited by setting `folded-file' to t in the file's local variables.
For example, having the following at the end of an Emacs-Lisp file
causes it to be folded when visited:

;; Local variables:
;; folded-file: t
;; end:

This only works if you have the appropriate hook set up.  Look up the
function `folding-mode-add-find-file-hook' for details.

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 `fold-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.

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 `fold-fold-on-startup' is set and
`fold-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 behaviour (toggling the mode), call it with
something like `(folding-mode nil t)'.

Here is the full list of keys bound in Folding mode:
\\{folding-mode-map}"

  ;;}}}

  (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
	    ;; Reach here when turning Folding mode off.
	    (progn
	      (setq folding-mode nil
		    selective-display nil)
	      (fold-clear-stack)
	      (widen)
	      (fold-change-visibility (list 1 (point-max)) t)
	      (fold-activate-keymap nil)
	      (fold-disable-narrow-on-mode-line nil))
	  ;; Reach here when turning Folding mode on.
	  ;; Trap errors in startup, so we can clear the variable
	  ;; `folding-mode'.  We can't wait until the end to set it,
	  ;; because some functions test its value.
	  (condition-case error
	      (progn
		(setq folding-mode t)
		(setq selective-display t)
		(setq selective-display-ellipses t)
		(widen)
		(set (make-local-variable 'fold-stack) nil)
		(make-local-variable 'fold-top-mark)
		(make-local-variable 'fold-secondary-top-mark)
		(make-local-variable 'fold-top-regexp)
		(make-local-variable 'fold-bottom-mark)
		(make-local-variable 'fold-bottom-regexp)
		(make-local-variable 'fold-regexp)
		;; Choose fold-marks for this major mode.
		(fold-compute-fold-marks)
		;; Call hooks.
		(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)))
		  (fold-set-mode-line)
		  (fold-activate-keymap t)
		  (fold-disable-narrow-on-mode-line t))
		(if fold-fold-on-startup
		    (if (or (interactive-p)
			    arg
			    inter)
			(fold-whole-buffer)
		      (save-restriction
			(save-excursion
			  (widen)
			  (goto-char (point-min))
			  ;; This will now not try to enter any folds.
			  (fold-whole-buffer))))
		  (fold-narrow-to-region nil nil t)))
	    (error
	     (folding-mode 0)
	     (signal (car error) (cdr error))))))))

;;}}}
;;{{{ fold-disable-narrow-on-mode-line

;; If ARG is non-nil, changes "%n" to the symbol
;; `fold-narrow-placeholder' in the current value of `mode-line-format'.
;; If ARG is nil, performs the reverse substitution.
;; `fold-narrow-placeholder' has the value nil; it serves simply to
;; indicate where to restore the "%n" when Folding mode is switched off.

(defconst fold-narrow-placeholder nil)

(defun fold-disable-narrow-on-mode-line (arg)
  (set (make-local-variable 'mode-line-format)
       (mapcar (function (lambda (x)
			   (if arg
			       (if (equal "%n" x) 'fold-narrow-placeholder x)
			     (if (eq 'fold-narrow-placeholder x) "%n" x))))
	       mode-line-format)))

;;}}}
;;{{{ fold-activate-keymap

;; If ENABLE is non-nil, turn on `folding-mode-map'.  Otherwise, turn it
;; off.  Different version of Emacs require different strategies for this.

;; In Emacs 19+, we use a minor-mode-map.  We rearrange
;; `minor-mode-map-alist' so the entry for Folding mode moves to the
;; top; if the user just asked for Folding mode, chances are they want
;; its bindings to override any others belonging to minor modes.

;; In Lucid Emacs, keymaps can have parent keymaps, so that mechanism is
;; used instead.  We need to copy `folding-mode-map' for this to work.

;; In other Emacs', we merge the active local keymap (if any) with our
;; keymap, and use that as the new local map.  We save the old keymap in
;; a variable, to be restored when Folding mode is exited.

;; In Lucid and Emacs 18 derivatives, we call `fold-merge-keymaps' to do
;; get a new local-map, and save the old local-map in `fold-saved-local-map'.

(defun fold-activate-keymap (enable)
  (fold-cc minor-mode-maps
      ;; Emacs 19+: Move any `folding-mode' entries to the head of the list.
      (and enable
	   (let* ((alist minor-mode-map-alist)
		  folds entry)
	     (while (setq entry (assq 'folding-mode alist))
	       (setq folds (cons entry folds))
	       (setq alist (delq entry alist)))
	     (setq minor-mode-map-alist (nconc (nreverse folds) alist))))
    ;; Emacs 18 or Lucid Emacs keymaps.
    (if enable
	(progn
	  (set (make-local-variable 'fold-saved-local-map)
	       (current-local-map))
	  (use-local-map (fold-merge-keymaps fold-saved-local-map
					     folding-mode-map)))
      ;; Don't restore an old keymap if something's not right.
      (and (boundp 'fold-saved-local-map)
	   (assq 'fold-saved-local-map (buffer-local-variables))
	   (use-local-map fold-saved-local-map))
      (kill-local-variable 'fold-saved-local-map))))

;;}}}
;;{{{ fold-clear-stack

;; Clear the fold stack, and release all the markers it refers to.

(defun fold-clear-stack ()
  (let ((stack fold-stack))
    (setq fold-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)))))

;;}}}
;;{{{ fold-set-mode-line

;; Sets `fold-mode-string' appropriately.  This allows the Folding mode
;; description in the mode line to reflect the current fold depth.

(defun fold-set-mode-line ()
  (if (null fold-stack)
      (kill-local-variable 'fold-mode-string)
    (make-local-variable 'fold-mode-string)
    (setq fold-mode-string (if (eq 'folded (car fold-stack))
			       " Fold:1"
			     (format " Folds:%d" (length fold-stack))))))

;;}}}

;;{{{ fold-compute-fold-marks

;; Compute and fold marks for current buffer, depending on various
;; variables.  Try the following strategies in order:

;; 1. If fold-marks is buffer-local and non-nil and a string, compute
;; the value of the fold marks from that.  In so doing, set fold-marks
;; to nil.  Syntax is unstable, but something like "/* {{{ T */ and /*
;; }}} */".  `T' denotes the title.  It is optional on both top and
;; bottom marks, but if the bottom mark has one, the top mark must too.
;; If no title position is given, it is assumed to go after the top
;; mark, separated by at least one space character.  `\' can quote any
;; character.  Sensible suggestions welcome for improvements to this
;; format.  One motivation is keeping the description small, to take up
;; little space in a file-local-variables line at the start of a file.

;; 2. If values are already set in fold-top-mark, fold-bottom-mark and
;; (optionally) fold-secondary-top-mark, use them.

;; 3. Otherwise, look up the major mode in fold-mode-marks-alist.  If
;; that doesn't give anything, use comment-start and comment-end if they
;; are available.  Check that the relevant variables are already
;; buffer-local.

;; If all else fails, there's always "{{{" and "}}}".

;; Fold marks can thus be set using file-local variables:

;; -*- fold-marks: "#{{{ and #}}}" -*-

;; Who knows how confused this will become when multiple fold marks and
;; outlining are combined :-).

;; FIXME -- not done fold-marks yet!

(defun fold-compute-fold-marks ()
  (let ((vars (buffer-local-variables))
	cstart cend fold-marks)
    (cond ((and (assq 'fold-top-mark vars)
		fold-top-mark
		(assq 'fold-bottom-mark vars)
		fold-bottom-mark
		(assq 'fold-secondary-top-mark vars))
	   (fold-set-marks fold-top-mark fold-bottom-mark
			   fold-secondary-top-mark))
	  ((setq fold-marks (assq major-mode fold-mode-marks-alist))
	   (apply 'fold-set-marks (cdr fold-marks)))
	  (t
	   (setq cstart (cdr (assq 'comment-start vars))
		 cend (cdr (assq 'comment-end vars)))
	   (fold-set-marks (concat (or cstart "") "{{{ ")
			   (concat (or cstart "") "}}}" (or cend ""))
			   cend)))))

;;}}}

;;}}}
;;{{{ Regular expressions for matching fold marks

;;{{{ fold-set-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 fold-set-marks (top bottom &optional secondary)
  "Sets the folding top and bottom marks for the current buffer.

The fold top mark is set to TOP, and the fold bottom mark is set to
BOTTOM.  And optional SECONDARY top mark can also be specified -- this
is inserted by `fold-fold-region' after the fold top mark, and is
presumed to be put after the title of the fold.  This is not necessary
with the bottom mark because it has no title.

Various regular expressions are set with this function, so don't set the
mark variables directly."
  (set (make-local-variable 'fold-top-mark)
       top)
  (set (make-local-variable 'fold-bottom-mark)
       bottom)
  (set (make-local-variable 'fold-secondary-top-mark)
       secondary)
  (set (make-local-variable 'fold-top-regexp)
       (concat "\\(^\\|\r+\\)[ \t]*"
	       (regexp-quote fold-top-mark)))
  (set (make-local-variable 'fold-bottom-regexp)
       (concat "\\(^\\|\r+\\)[ \t]*"
	       (regexp-quote fold-bottom-mark)))
  (set (make-local-variable 'fold-regexp)
       (concat "\\(^\\|\r\\)\\([ \t]*\\)\\(\\("
	       (regexp-quote fold-top-mark)
	       "\\)\\|\\("
	       (regexp-quote fold-bottom-mark)
	       "[ \t]*\\(\\)\\($\\|\r\\)\\)\\)")))

;;}}}

;;}}}
;;{{{ Searching for fold boundaries

;;{{{ fold-search-for-mark

;; Searches forward (backward if BACKWARD is non-nil) for any kind of
;; fold mark.  Returns nil if no fold mark was found, or a cons cell
;; (POS . OPENING-P).  POS is the position at the beginning of the line
;; containing the fold mark that was found.  OPENING-P is t if the
;; fold-mark was an opening mark, nil otherwise.

;; Optional arg OUTSIDE has same meaning as for `fold-skip-folds'.

;; Note that this function is *not* used by `fold-skip-folds'.

(defun fold-search-for-mark (backward &optional outside)
  (let ((inhibit-point-motion-hooks t) ; Speed up searching.
	(depth 0) pairs point temp start first last
	(first-mark (if backward fold-bottom-mark fold-top-mark))
	(last-mark (if backward fold-top-mark fold-bottom-mark))
	(search (if backward 'search-backward 'search-forward)))
    (save-excursion
      (skip-chars-backward "^\r\n")
      (if outside
	  nil
	(and (eq (preceding-char) ?\r)
	     (forward-char -1))
	(if (looking-at fold-top-regexp)
	    (if backward
		(setq last (match-end 1))
	      (skip-chars-forward "^\r\n"))))
      ;; Find last first, prevents unnecessary searching for first when
      ;; we are inside a fold.
      (setq point (point))
      (or last
	  (while (and (funcall search 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 (funcall search 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))))))
      (if (and first
	       (or (not last)
		   (< first last)))
	  (cons first (not backward))
	(and last
	     (cons last backward))))))

;;}}}
;;{{{ fold-search-for-text

;; Search forward for any non-whitespace text.  Returns the position
;; found, or nil if nothing found.  The point is not moved.
;;
;; If IGNORE-COMMENTS is non-nil, comments are ignored during the
;; search.  If it is not nil and not t, the position of a comment which
;; is found is returned if nothing else was found.  Note that the search
;; must start outside of a comment for this to work.
;;
;; If MATCH-FOLDS is non-nil, fold marks count don't count as comments.
;;
;; The syntactic category of ^M is temporarily set to be the same as
;; line-feed, for proper comment parsing in selective-display (but only
;; if Folding mode is using selective-display).

(defun fold-search-for-text (ignore-comments match-folds)
  (let* ((table (syntax-table))
	 (syntax (aref table ?\C-m))
	 p1 p2 p3
	 (inhibit-point-motion-hooks t))
    (save-excursion
      (skip-chars-forward "\t\C-l ")
      (cond ((eobp)
	     nil)
	    ((not ignore-comments)
	     (point))
	    (t
	     (unwind-protect
		 (progn
		   ;; Temporarily set syntax of ^M.
		   (and selective-display
			(aset table ?\C-m (aref table ?\n)))
		   (setq p1 (point))	; Start of first comment or whatever.
		   ;; FIXME -- Emacs 19 only.
		   (forward-comment (buffer-size))
		   (setq p2 (point))
		   (and match-folds
			(progn
			  (goto-char p1)
			  (and (setq p3 (car (fold-search-for-mark nil t)))
			       (setq p2 (min p2 p3)))))
		   (if (/= p2 (point-max))
		       p2
		     (and (not (eq t ignore-comments)) p1)))
	       (aset table ?\C-m syntax)))))))

;;}}}
;;{{{ fold-compute-indentation

;; Compute indentation for new fold marks, based on buffer contents.

;; Args: START and END, the region that the new fold will surround (they
;; are both at the start of a line).  POS is the value of point when
;; fold-fold-region was called; its indentation is used if the region
;; contains only whitespace.  POS may be nil, in which case its value
;; isn't used.

;; Return value: an integer.

(defun fold-compute-indentation (start end &optional pos)
  (let ((i fold-mark-indentation-function))
    (cond ((integerp i) (max i 0))
	  ((null i) 0)
	  ((eq t i)
	   ;; Skip backwards to non-blank char, skipping comments but
	   ;; not fold marks.  Return the indentation of the first
	   ;; non-blank line found.
	   (save-excursion
	     (save-restriction
	       (let ((inhibit-point-motion-hooks t)
		     p1)
		 (narrow-to-region 1 end)
		 (goto-char start)
		 (if (setq p1 (fold-search-for-text 0 t))
		     (progn
		       (widen)
		       (goto-char p1)
		       (skip-chars-backward "^[\n\C-m]")
		       ;; Narrow region otherwise current-indentation
		       ;; will skip backwards over a ^M.
		       (narrow-to-region (point) (point-max))
		       (current-indentation))
		   ;; Use the indentation from POS then.
		   (if (not pos)
		       0
		     (narrow-to-region 1 pos)
		     (skip-chars-backward "^[\n\C-m]")
		     (current-indentation)))))))
	  (t				; A function to call.
	   (save-excursion
	     (save-restriction
	       (widen)
	       (let ((buffer-read-only t))
		 (funcall i start end))))))))

;;}}}

;;{{{ fold-scan-fast

;; Search quickly through a buffer for lines matching patterns from a
;; list of patterns, using a funky algorithm.  The search is done by
;; searching for small and rare fixed text strings, and then checking
;; the line using regular expressions.  Multiple pattern search is
;; optimised by cycling through different patterns, bounding the search
;; for subsequent patterns by the nearest found so far, and retaining
;; information about each pattern found from one match to the next.
;;
;; PATTERN-LIST is the set of patterns to look for.  Its form is still
;; experimental.  It is a list, where each element has one of these forms:
;;
;;    (APPROX-STRING SYMBOL)
;;    (APPROX-STRING REGEXP MATCHNUM SYMBOL [MATCHNUM SYMBOL...])

;; FIXME: OUTSIDE processing isn't right yet.
;; FIXME: Blindly pushing every position doesn't create the right
;; pairs for fold-whole-buffer.
;; FIXME: This function is too tricky to hold in my head! :-/

;; Algorithm:
;;
;;    A list called `approx-list' is maintained which has an entry for
;;    each pattern.  Entries in this list have the form:
;;
;;          (EXTENT SYMBOL . PATTERN)
;;
;;    PATTERN is the corresponding entry from PATTERN-LIST, which always
;;    starts with a string APPROX-STRING.
;;
;;    EXTENT says how far we have already searched for the APPROX-STRING
;;    for PATTERN, so we don't need to repeat that.  If EXTENT is nil,
;;    we haven't searched at all for this string yet.  Otherwise, EXTENT
;;    is a position in the buffer.
;;
;;    SYMBOL is either nil, or a symbol from the corresponding match in
;;    PATTERN.  If SYMBOL is not nil, it means that a match was found
;;    at position EXTENT.
;;
;;    To search forward, the fast Boyer-Moore string searching routine
;;    `search-forward' is used to search forward for a line containing
;;    APPROX-STRING, and then the regular expression or string match
;;    (skipping indentation whitespace) are used to check whether that
;;    line matches the pattern that is guarded by APPROX-STRING.
;;
;;    If the line doesn't match the pattern after all, the position
;;    reached by the Boyer-Moore search is stored in EXTENT, so that we
;;    don't have to repeat it.
;;
;;    This is done for each entry in `approx-list' in turn, until the
;;    nearest one is found.

(defun fold-scan-fast-init (pattern-list backward &optional outside)
  (let ((inhibit-point-motion-hooks t)
	(approx-list (mapcar (function (lambda (x) (cons nil (cons nil x))))
			     pattern-list))
	(skip-to-eol (if fold-use-selective-display "^\r\n" "^\n"))
	first-possible)
    (or backward (setq approx-list (nreverse approx-list)))
    (or outside
	(save-excursion
	  (if backward
	      (skip-chars-backward skip-to-eol)
	    (skip-chars-forward skip-to-eol))
	  (setq first-possible (point))))
    (if backward
	(skip-chars-forward skip-to-eol)
      (skip-chars-backward skip-to-eol))
    (cons (list backward first-possible) approx-list)))

(defun fold-scan-fast-next (scanner-state)
  (let ((inhibit-point-motion-hooks t)	; Speed up searching.
	(approx-list (cdr scanner-state))
	(near-limit (if backward (point-min) (point-max)))
	(skip-to-eol (if fold-use-selective-display "^\r\n" "^\n"))
	(backward (car (car scanner-state)))
	(first-possible (nth 1 (car scanner-state)))
	current-point sym i pattern)

    ;; Find the bound of this search.  `scanner-state' might contain a
    ;; candidate match already from a previous search, in which case
    ;; that bounds searches for other patterns.
    (setq pattern approx-list)
    (while pattern
      (and (natnump (setq i (car (car pattern))))
	   (if backward (> i near-limit) (< i near-limit))
	   (setq near-limit i))
      (setq pattern (cdr pattern)))

    ;; Iterate over all the patterns in `approx-list' that have nil EXTENT.
    (setq current-point (point))
    (while (setq pattern (assq nil approx-list))
      (goto-char current-point)
      ;;{{{ Search for a line matching `pattern' as far as `near-limit'

      ;; For a particular pattern, search as far as `near-limit' for
      ;; a matching line.  Search repeatedly for APPROX-STRING if
      ;; necessary until `near-limit' is reached.
      (while (and (not (car pattern))
		  (if backward
		      (search-backward (nth 2 pattern) near-limit t)
		    (search-forward (nth 2 pattern) near-limit t)))
	;; We reach here if APPROX-STRING was found, and it ended
	;; before `near-limit'.  Now see if the line we are on
	;; matches the string or regular expression in PATTERN.  If
	;; the line matches, car of APPROX is set to the position of
	;; the end of the line (the beginning if BACKWARD).  `sym'
	;; contain the matching symbol from PATTERN, or may have any
	;; value otherwise.  Point is set to the position to
	;; continue searching from next.
	(if (not (symbolp (setq sym (nth 3 pattern))))
	    (progn
	      ;; This is a regex match.  See if the regex matches,
	      ;; and which subpattern in the regex matches.  The
	      ;; match is always tried from the start of the line.
	      (skip-chars-backward skip-to-eol)
	      (if (prog1 (looking-at sym)
		    ;; Whether the regex matched or didn't, don't
		    ;; include the current line in any further searches
		    ;; for this pattern.  This is done here so that the
		    ;; `(setcar pattern (point))' below is correct.
		    (or backward (skip-chars-forward skip-to-eol)))
		  (progn
		    (setq i 4)
		    (while (and (< i (length pattern))
				(not (match-beginning (nth i pattern))))
		      (setq i (+ i 2)))
		    (setq sym (nth (1+ i) pattern))
		    (setcar pattern (point)))))
	  ;; This is a pure string match.  See if the string
	  ;; appears at the beginning of the line after whitespace.
	  ;; If not, we need to continue the search.
	  (goto-char (match-beginning 0))
	  (skip-chars-backward " \t")
	  (if (or (bolp) (and fold-use-selective-display
			      (eq (preceding-char) ?\r)))
	      (progn
		(or backward (skip-chars-forward skip-to-eol))
		(setcar pattern (point)))
	    ;; The matched position isn't the beginning of the line
	    ;; after whitespace.  Rather than moving to the beginning of
	    ;; the line and seeing if there is a match there, simply
	    ;; continue searching from where we have reached.  If
	    ;; searching forwards, that means continue from the end of
	    ;; the line.  If searching backwards, continue from the
	    ;; current match-end minus 1 (because of the possibility of
	    ;; overlapping matches, e.g. of "foofoo" in "foofoofoo").
	    (if backward
		(goto-char (1- (match-end 0)))
	      (skip-chars-forward skip-to-eol)))))

      ;;}}}
      (if (not (car pattern))
	  ;; No matching line was found before `near-limit'.
	  (progn (setcar pattern (- near-limit))
		 (setcar (cdr pattern) nil))
	;; A matching line was found.  See if this reduces `near-limit'.
	(setcar (cdr pattern) sym)
	(setq i (car pattern))
	(and (if backward (> i near-limit) (< i near-limit))
	     (setq near-limit i))))

    ;; We've checked all the patterns to find the nearest match.  If
    ;; there is a match, it is at position `near-limit', and the
    ;; approx-list entries which match that line have that value as
    ;; their CAR.  Clear all entries on that line (so that searching can
    ;; continue at the next iteration), and return the SYMBOL of the
    ;; first entry clear which corresponds to a match.
    (goto-char near-limit)
    (and (setq pattern (assq near-limit approx-list))
	 (progn
	   (setq sym (nth 1 pattern))
	   (setcar pattern nil)
	   (while (setq pattern (assq near-limit approx-list))
	     (setcar pattern nil))
	   (setq near-limit (- near-limit))
	   (while (setq pattern (assq near-limit approx-list))
	     (setcar pattern nil))
	   ;; Return value.
	   sym))))

(defun fold-scan-fast (pattern-list backward &optional outside)
  (save-excursion
    (let* ((scanner-state (fold-scan-fast-init pattern-list backward outside))
	   (counter (buffer-size))
	   (depth 0)
	   (first-possible (nth 1 (car scanner-state)))
	   sym result)
      (while (and (natnump (setq counter (1- counter)))
		  (setq sym (fold-scan-fast-next scanner-state)))
	(if (eq sym (if backward 'fold-start 'fold-end))
	    ;; Exiting fold.
	    (progn
	      (if (natnump (setq depth (1- depth)))
		  (and (zerop depth)
		       (setq result (cons (point) result)))
		(setq counter 0)
		(setq result (cons (point) result))))
	  ;; Entering fold (unless outside is nil).
	  (and (or outside
		   (not (eq (point) first-possible)))
	       (eq 1 (setq depth (1+ depth)))
	       (setq result (cons (point) result)))
	  (setq outside t)))

      ;; Return a result.
      (if (natnump depth)
	  (cons nil result)
	result))))

(setq fold-fast-pattern nil)
(defvar fold-fast-pattern nil)
(make-variable-buffer-local 'fold-fast-pattern)

;;}}}

(setq c-mode-fast-pattern
      '(("{{{" "[ \t]*/[*/] ?{{{ ?" 0 fold-start)
	("}}}" "[ \t]*/[*/] ?}}} ?" 0 fold-end)))
(setq c-mode-fold-top-regexp
      "\\(^\\|\\r+\\)[ \t]*/[*/] ?{{{ ?")
(setq c-mode-fold-bottom-regexp
      "\\(^\\|\\r+\\)[ \t]*/[*/] ?}}} ?")

;;{{{ fold-skip-folds

;; 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 fold-mark pairs on the way.
;; Returns t if the end of buffer was found in an unmatched fold-mark
;; pair, otherwise a list.  Does not widen the buffer for the search.

;; If the point is actually on a 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.  This is as if start marks are at
;; the beginning of a line, and end marks at end of one.  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 indicate 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.  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.

(defun fold-skip-folds (backward &optional outside)
  (cond ((or (eq major-mode 'c-mode) (eq major-mode 'c++-mode))
	 (setq fold-fast-pattern c-mode-fast-pattern)
	 (setq fold-top-regexp c-mode-fold-top-regexp)
	 (setq fold-bottom-regexp c-mode-fold-bottom-regexp))
	(t
	 (or fold-fast-pattern
	     (setq fold-fast-pattern
		   (list (list fold-top-mark 'fold-start)
			 (list fold-bottom-mark 'fold-end))))))
  (fold-scan-fast fold-fast-pattern backward outside))

;;}}}

;;}}}
;;{{{ Choosing new fold titles

;;{{{ fold-lisp-choose-title

;; In any of the Lisp modes, definitions begin with `(defXXX NAME'.  The
;; matching of `defXXX' where `XXX' may be any valid symbol name is
;; consistent with Emacs-Lisp mode's indentation engine.
;;
;; For code like GCC's RTL machine description language, we also match
;; `(defXXX "NAME"', provided NAME is a valid symbol name.  In this
;; case, the suggested fold title includes both the name, and the exact
;; variant of `defXXX'.

(defun fold-lisp-choose-title ()
  (cond ((looking-at "\(def[^][ \t\r\n#'\"();]+[ \t\r\n]+\\([^][ \t\r\n#'\"();]+\\)")
	 (match-string-no-properties 1))
	((looking-at "\(\\(def[^][ \t\r\n#'\"();]+\\)[ \t\r\n]+\\(\"[^][ \t\r\n#'\"();]+\"\\)")
	 (concat (match-string-no-properties 1)
		 " "
		 (match-string-no-properties 2)))))

;;}}}
;;{{{ fold-perl-choose-title

;; In Perl mode, fold titles are suggested whenever the text begins with
;; a variable or subroutine definition.  Any of the following forms
;; match (note that VARIABLE must begin with $, @ or %).
;;
;;   sub SUBNAME
;;   my VARIABLE ;
;;   my VARIABLE =
;;   local VARIABLE ;
;;   local VARIABLE =
;;   VARIABLE ;
;;   VARIABLE =

(defun fold-perl-choose-title ()
  (cond ((looking-at "sub[ \t\r\n]+\\([_a-zA-Z][_a-zA-Z0-9]*\\)")
	 (match-string-no-properties 1))
	((looking-at "\\(my[ \t]+\\|local[ \t]+\\)?\\([$@%][_a-zA-Z][_a-zA-Z0-9]*\\)[ \t\r\n]*[=;]")
	 (match-string-no-properties 2))))

;;}}}
;;{{{ fold-c-choose-title

;; We are looking for C function, variable and structure definitions.
;; We cannot tell which words are typedefs, hence part of a type,
;; and which words are the name of the object being defined.
;; So we guess using some simple rules.
;;
;; Function definitions look like one of these:
;;
;;   NAME (ARGS...) {
;;   TYPE NAME (ARGS...) {
;;   TYPE (NAME) (ARGS...) {
;;
;; We match the old style of function names without a return type, but
;; not if there are K&R style argument types following the argument list.
;;
;; Variable definitions look like one of these:
;;
;;   TYPE NAME ;
;;   TYPE NAME =
;;   TYPE NAME [...] ;
;;   TYPE *NAME ;
;;   TYPE (*NAME) [...] ;
;;   TYPE (*(*NAME)) ;
;;   etc.
;;
;; Nearly any sequence of words is accepted as the TYPE, because they
;; may be typedef types.  TYPE must begin with at least one plain word.
;; A type may also be a structure definition (or enum), which we skip
;; over as if it were a single word.  For example, these are both
;; definitions of NAME which we recognise:
;;
;;   struct { int x, int y; } NAME (ARGS...) {
;;   struct { int x, int y; } NAME =
;;
;; If we see "struct" or "enum" with a tag-name, then this is a
;; definition of the tag-name, and we return that without parsing
;; further.  We include the "struct" keyword in the title in this case.
;; For example:
;;
;;   struct TAG-NAME {
;;
;; However, these are not definitions of TAG-NAME:
;;
;;   struct TAG-NAME NAME (ARGS...) {
;;   struct TAG-NAME NAME =
;;
;; Note that in some cases, struct NAME may be the start of a definition
;; of both a tag-name _and_ a function, variable, or typedef.  In such
;; cases we should probably return both, comma-separated, as "struct
;; NAME, FUNCTION".
;;
;; Currently we will return just the "struct TAG-NAME" in such cases.
;; The behaviour is consistent with a general rule about multiple
;; definitions: When a new fold contains multiple definitions, the name
;; of the first definition is suggested as the fold title.

;; NOTE: This code isn't finished.  Examples it won't match:
;;
;;   char * ptr;
;;   function (...) {
;;   static char * function (...) {
;;   struct { ... } function (...) {
;;   struct { ... } var;
;;   void * xrealloc (...) {
;;   class TAG-NAME :
;;   #define NAME
;;
;; Examples it shouldn't match:
;;
;;   for (...) buffer [i] =
;;   function (...) ;
;;   struct TAG-NAME * function         [[ shouldn't match "struct TAG-NAME" ]]
;;
;; It should also match C++-style qualified names ("a::b") and remove any
;; whitespace surrounding the "::"s.  Templates are probably too complex,
;; and should be left for the user to supply a suitable name.

(defun fold-c-choose-title ()
  (let (word struct-keyword fn-name nonfn-name is-extern char not-first)
    (catch 'title
      (while t
	;;(message "fn-name %S nonfn-name %S" (point) fn-name nonfn-name)
	(if (looking-at "\\([_a-zA-Z@$][_a-zA-Z0-9@$]*\\)[ \t\r\n]*")
	    (progn
	      ;; Skip single words, and remember whether we've passed a
	      ;; struct keyword.  The last word matched here is usually
	      ;; the name we're interested in -- that's what nonfn-name
	      ;; is set here.
	      (setq word (match-string-no-properties 1))
	      (goto-char (match-end 0))
	      (and (string= "extern" word) (setq is-extern t))
	      (if (null struct-keyword)
		  (setq nonfn-name (and not-first word))
		(looking-at "[{:]")	; Struct definition (":" is for C++).
		(throw 'title (concat struct-keyword " " word))
		(setq nonfn-name nil))
	      (setq fn-name nil not-first t)
	      (setq struct-keyword
		    (and (string-match "^\\(class\\|struct\\|enum\\)$" word)
			 word)))
	  (or not-first (throw 'title nil)) ; Must begin with a non-name word.
	  (setq struct-keyword nil char (following-char))
	  (cond ((eq char ?\{)		; Start of function body.
		 (throw 'title fn-name))
		((eq char ?\;)		; Variable or typedef, decl or defn.
		 (throw 'title (if is-extern nil nonfn-name)))
		((eq char ?\=)		; Variable or typedef, defn.
		 (throw 'title nonfn-name))
		((eq char ?\[)		; Array args, part of type to skip.
		 (condition-case nil (forward-sexp)
		   (scan-error (throw 'title nil)))
		 (skip-chars-forward " \t\r\n")
		 (setq fn-name nil))
		((eq char ?\()		; Function args, or (NAME) or (*NAME).
		 (if (looking-at "([ \t\r\n]*\\([*&]+[ \t\r\n]*\\)*\\([_a-zA-Z@$][_a-zA-Z0-9@$]*\\)[ \t\r\n]*)[ \t\r\n]*")
		     (progn		; May be args or plain (NAME).
		       (setq word (match-string-no-properties 2))
		       (goto-char (match-end 0))
		       (setq fn-name nonfn-name nonfn-name word))
		   ;; Function args.  Skip them and note that the previous
		   ;; word may be a function name.
		   (condition-case nil (forward-sexp)
		     (scan-error (throw 'title nil)))
		   (skip-chars-forward " \t\r\n")
		   (setq fn-name nonfn-name)))
		(t
		 (throw 'title nil))))))))

;;}}}

;; Choose a title for new fold marks, based on buffer contents.
;;
;; Args: START and END, the region that the new fold will surround (they
;; are both at the start of a line).
;;
;; Return value: a string, or nil.

(defun fold-compute-title (&optional start end)
  "Choose a title for new fold marks, based on text inside the fold.

The text from START to END is examined.  First, any comments are skipped
\(except for fold marks; they are not skipped).  Then if the search did
not stop at a fold mark, a mode-specific function examines the text and
chooses a title.

Currently the major modes which provide titles are Perl, Emacs Lisp (and
other Lisp modes), C and C++.  In these modes, if the text starts with a
function, variable, subroutine, type, structure etc. definition, then
the name of the thing being defined is chosen as the fold title."
  (interactive "r")
  (or start (setq start (point) end (point-max)))
  (save-excursion
    (save-restriction
      (let ((inhibit-point-motion-hooks t)
	    p1)
	(narrow-to-region 1 end)
	(goto-char start)
	(if (setq p1 (fold-search-for-text t 0))
	    (progn
	      (widen)
	      (goto-char p1)
	      (cond ((memq major-mode '(emacs-lisp-mode lisp-interaction-mode
							lisp-mode scheme-mode))
		     (fold-lisp-choose-title))
		    ((memq major-mode '(c-mode c++-mode cc-mode elec-c-mode))
		     (fold-c-choose-title))
		    ((eq major-mode 'perl-mode)
		     (fold-perl-choose-title)))))))))

;;}}}
;;{{{ Interactive functions

;;{{{ Cursor movement that skips folded regions

;;{{{ fold-forward-char

(defun fold-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."
  (interactive "p")
  (fold-cc crs
      (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)))
	    (fold-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")))))))))
    (forward-char arg)))

;;}}}
;;{{{ fold-backward-char

(defun fold-backward-char (&optional arg)
  "Move point left ARG characters, skipping hidden folded regions.
Moves right if ARG is negative.  On reaching beginning of buffer, stop
and signal error."
  (interactive "p")
  (fold-cc crs
      (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)))
	    (fold-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))))))))
    (backward-char arg)))

;;}}}
;;{{{ fold-end-of-line

(defun fold-end-of-line (&optional arg)
  "Move point to end of current line, but before hidden folded region.

Has the same behavior as `end-of-line', except that if the current line
ends with some hidden folded text, the point is positioned just before
it.  This prevents the point from being placed inside the folded text,
which is not normally useful."
  (interactive "p")
  (fold-cc crs
      (progn
	(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"))
    (end-of-line arg)))

;;}}}
;;{{{ fold-skip-ellipsis-backward

(defun fold-skip-ellipsis-backward ()
  "Moves 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))

;;}}}

;;}}}
;;{{{ Moving in, out and between folds

;;{{{ fold-enter

(defun fold-enter (&optional noerror noenter)
  "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 already 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 that don't know about
Folding mode; e.g., search commands.

Optional second arg  NOENTER says how to enter folds.
  nil -- means enter as many folds as possible.
  t   -- means enter as few folds as possible to avoid being in hidden text.
  num -- any integer means to stop entering at that depth, provided this
         lies between the minimum and maximum allowable values."
  (interactive)
  (or folding-mode
      (error "fold-enter: Folding mode not active"))
  (and noenter
       (not (integerp noenter))
       (setq noenter 0))
  (let ((goal (point)))
    (if (fold-skip-ellipsis-backward)
	(let ((depth (length fold-stack)))
	  (and noenter (goto-char goal))
	  (while (and (if (and noenter (>= depth noenter))
			  (fold-skip-ellipsis-backward)
			t)
		      (prog2 (beginning-of-line)
			  (fold-enter t)
			(setq depth (1+ depth))
			(goto-char goal)))))
      (let ((data (and (or (not noenter)
			   (< (length fold-stack) noenter))
		       (fold-show noerror t))))
	(and data
	     (progn
	       (setq fold-stack
		     (if fold-stack
			 (cons (cons (point-min-marker) (point-max-marker))
			       fold-stack)
		       '(folded)))
	       (fold-set-mode-line)
	       (fold-narrow-to-region (car data) (nth 1 data))
	       (fold-tidy-inside)
	       (nth 2 data)))))))

;;}}}
;;{{{ fold-exit

(defun fold-exit ()
  "Exits the current fold."
  (interactive)
  (or folding-mode
      (error "fold-exit: Folding mode is not active"))
  (if fold-stack
      (progn
	(fold-tidy-inside)
	(fold-change-visibility (list (point-min) (point-max)) nil)
	(goto-char (point-min))	       ;; So point is correct in other windows.
	(if (eq (car fold-stack) 'folded)
	    (fold-narrow-to-region nil nil t)
	  (fold-narrow-to-region (marker-position (car (car fold-stack)))
				 (marker-position (cdr (car fold-stack))) t))
	(and (consp (car fold-stack))
	     (set-marker (car (car fold-stack)) nil)
	     (set-marker (cdr (car fold-stack)) nil))
	(setq fold-stack (cdr fold-stack)))
    (error "Outside all folds"))
  (fold-set-mode-line))

;;}}}
;;{{{ fold-show

(defun fold-show (&optional noerror noskip)
  "Opens the fold that the point is on, but does not enter it.
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 "p")
  (or folding-mode
      (error "fold-show: Folding mode is not active"))
  (or noskip
      (fold-skip-ellipsis-backward))
  (let ((point (point))
	backward forward start end subfolds-not-p)
    (unwind-protect
	(or (and (integerp (car-safe (setq backward (fold-skip-folds t))))
		 (integerp (car-safe (setq forward (fold-skip-folds nil))))
		 (progn
		   (goto-char (car forward))
		   (skip-chars-forward "^\r\n")
		   (setq end (point))
		   (skip-chars-forward "\r\n")
		   (not (and fold-stack (eobp))))
		 (progn
		   (goto-char (car backward))
		   (skip-chars-backward "^\r\n")
		   (setq start (point))
		   (skip-chars-backward "\r\n")
		   (not (and fold-stack (bobp))))
		 (progn
		   ;; This is causing all the trouble with fold-goto-line
		   ;; moving to the start of a fold...
		   ;;(setq point start)
		   (setq subfolds-not-p	; Avoid holding the list through a GC.
			 (not (or (cdr backward) (cdr forward))))
		   (fold-change-visibility
		    (append backward (nreverse forward)) t)
		   (list start end (not subfolds-not-p))))
	    (if noerror
		nil
	      (error "Not on a fold")))
      (goto-char point))))

;;}}}
;;{{{ fold-hide

(defun fold-hide ()
  "Close the fold around the point, undoes effect of `fold-show'."
  (interactive)
  (or folding-mode
      (error "fold-mark: Folding mode is not active"))
  (fold-skip-ellipsis-backward)
  (let ((start (car-safe (fold-skip-folds t)))
	end) ;; Don't search unless necessary.
    (if (and (integerp start)
	     (integerp (setq end (car-safe (fold-skip-folds nil)))))
	(if (and fold-stack
		 (or (eq start (point-min))
		     (eq end (point-max))))
	    (error "Cannot hide current fold")
	  (goto-char start)
	  (skip-chars-backward "^\r\n")
	  (fold-change-visibility (list start end) nil))
      (error "Not on a fold"))))

;;}}}
;;{{{ fold-top-level

(defun fold-top-level ()
  "Exits all folds, to the top level.
Outside of Folding mode, does nothing."
  (interactive)
  (and folding-mode
       (while fold-stack
	 (fold-exit))))

;;}}}

;;}}}
;;{{{ Functions that actually modify the buffer

;;{{{ fold-fold-region

(defun fold-fold-region (start end)
  "Places fold marks 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
original position of point may be used to determine the new fold's
indentation, if the region contains only whitespace.

The initial indentation of the fold-marks is determined from
`fold-mark-indentation-function'.  See that variable's documentation
for details."
  (interactive "r")
  (or folding-mode
      "fold-fold-region: Folding mode is not active")
  (and (markerp start) (setq start (marker-position start)))
  (and (markerp end) (setq end (marker-position end)))
  ;; More "default selected region" contortions.
  (cond ((< end start)
	 (setq start (prog1 end
		       (setq end start))))
	((eq end start)
	 (goto-char start)
	 (skip-chars-backward " \t\C-l")
	 (and (or (bolp)
		  (eq (preceding-char) ?\C-m))
	      (setq end (point)
		    start (point)))))
  (let ((pos (point)))
    (goto-char start)
    (beginning-of-line)
    (setq start (point))
    (let ((indent (fold-compute-indentation start end pos))
	  (title (fold-compute-title start end)))
      ;; Ensure end is adjusted by insertions at start.
      (setq end (- (buffer-size) end))
      (indent-to indent)
      (insert fold-top-mark)
      (let ((saved-point (point)))
	(and title (insert title))
	(and fold-secondary-top-mark
	     (insert fold-secondary-top-mark))
	(insert ?\n)
	;; This goes to the adjusted end-of-region.
	(goto-char (- (buffer-size) end))
	(and (not (bolp))
	     (eq 0 (forward-line))
	     (eobp)
	     (insert ?\n))
	(indent-to indent)
	(insert fold-bottom-mark ?\n)
	(setq fold-stack (if fold-stack
			     (cons (cons (point-min-marker)
					 (point-max-marker))
				   fold-stack)
			   '(folded)))
	(fold-narrow-to-region start (1- (point)))
	(goto-char saved-point)
	(fold-set-mode-line)
	(save-excursion (fold-tidy-inside))))))

;;}}}
;;{{{ fold-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 fold-tidy-inside ()
  "Adjusts whitespace at the beginning and end 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
`fold-internal-margins', which is 1 by default.

If `fold-tidy-mark-indentation' is non-nil, the indentation of the
bottom fold mark is set to be the same as the indentation of the top
one.

Does nothing if called non-interactively (from within a program) and
the buffer is read-only."
  (interactive)
  (or folding-mode
      (error "fold-tidy-inside: Folding mode is not active"))
  (if (and buffer-read-only (not (interactive-p)))
      ;; If it is interactive, a read-only error will be signalled later
      ;; if we have any changes to make.
      nil
    (save-excursion
      (let (top-indent
	    top-exists
	    bottom-indent
	    bottom-exists
	    p1 p2 p3
	    mark-indent)
	;; First gather some values; try to propagate known values in both
	;; directions when one of the marks is corrupt.
	(let ((inhibit-point-motion-hooks nil))
	  (goto-char (point-min))
	  (skip-chars-forward "\n\t ")
	  (and fold-tidy-mark-indentation
	       ;; This value is ignored if we haven't really got a top mark.
	       (setq top-indent (current-indentation)))
	  (beginning-of-line)
	  (setq p1 (point))
	  (if (looking-at fold-top-regexp)
	      (setq top-exists t)
	    (setq top-indent nil))
	  (goto-char (point-max))
	  (skip-chars-backward "\n\t ")
	  (beginning-of-line)
	  (and (looking-at fold-bottom-regexp)
	       (progn
		 (skip-chars-forward "\t ")
		 (setq bottom-exists t)
		 (and fold-tidy-mark-indentation
		      (setq bottom-indent (current-indentation))))))
	;; Compute new indentation for both marks.
	(and fold-tidy-mark-indentation
	     (setq mark-indent
		   (or top-indent
		       bottom-indent
		       ;; Try to compute it the same as for new fold marks,
		       ;; if there was no information from pre-existing marks.
		       (setq mark-indent
			     (fold-compute-indentation (point-min)
						       (point-max))))))
	;; Clear whitespace and do cleanups around beginning-of-fold mark.
	;; First delete all initial whitespace-only lines.
	(goto-char p1)
	(or (bobp)
	    (delete-region (point-min) (point)))
	(and (if top-exists
		 ;; If top-exists, there should be no need to adjust
		 ;; its indentation.
		 (progn (forward-line 1)
			(and (eobp) (insert ?\n))
			t)
	       (progn
		 (barf-if-buffer-read-only)
		 (and (y-or-n-p "Insert missing top fold mark? ")
		      (progn (and fold-tidy-mark-indentation
				  (> mark-indent 0)
				  (indent-to mark-indent))
			     (insert (concat fold-top-mark
					     "<Replaced missing top fold mark>"
					     (or fold-secondary-top-mark "")
					     "\n"))
			     t))))
	     ;; Now adjust internal top margin.
	     ;; Minimize buffer modification.
	     (natnump fold-internal-margins)
	     (setq 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 fold-internal-margins)))
		     (if (< p2 p3)
			 (newline (- p3 p2))
		       (delete-region p3 p2)))
	       (delete-region p1 p3)
	       (or (eq 0 fold-internal-margins)
		   (newline fold-internal-margins))))
	;; Clear whitespace and do cleanups around end-of-fold mark.  If
	;; the user said "no" to the above question, the narrowed region
	;; might be completely empty now!
	(goto-char (point-max))
	(skip-chars-backward "\n\t ")
	(or (bolp) (end-of-line))
	(or (eobp)
	    (delete-region (point) (point-max)))
	(and (if bottom-exists
		 (progn
		   (and fold-tidy-mark-indentation
			(/= bottom-indent mark-indent)
			(progn
			  (beginning-of-line)
			  (setq p1 (point))
			  (skip-chars-forward "\t ")
			  (or (eq p1 (point))
			      (delete-region p1 (point)))
			  (indent-to mark-indent)))
		   t)
	       (barf-if-buffer-read-only)
	       (and (y-or-n-p "Insert missing bottom fold mark? ")
		    (progn
		      (insert ?\n)
		      (and fold-tidy-mark-indentation
			   (> mark-indent 0)
			   (indent-to mark-indent))
		      (insert fold-bottom-mark)
		      t)))
	     ;; Now adjust internal bottom margin.
	     ;; Minimize buffer modification.
	     (natnump fold-internal-margins)
	     (setq p1 (progn (beginning-of-line) (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 fold-internal-margins)))
		     (if (> p2 p3)
			 (newline (- p2 p3))
		       (delete-region p2 p3)))
	       (delete-region p3 p1)
	       (newline (1+ fold-internal-margins))))))))

;;}}}

;;}}}
;;{{{ Operations on the whole buffer

;;{{{ fold-whole-buffer

(defun fold-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), and then entered again to get back to the original position
and fold depth.

The buffer modification flag is not affected, and this function will
work on read-only buffers."

  (interactive)
  (or folding-mode
      (error "fold-whole-buffer: Folding mode is not active"))
  (message "Folding buffer...")
  (let ((narrow-min (point-min))
	(narrow-max (point-max))
	(depth (length fold-stack))
	fold-list fold)
    (save-excursion
      (widen)
      (goto-char 1)
      (setq fold-list (fold-skip-folds nil t))
      (narrow-to-region narrow-min narrow-max)
      (and (eq t fold-list)
	   (error "Cannot fold whole buffer -- unmatched begin-fold mark"))
      (and (integerp (car fold-list))
	   (error "Cannot fold whole buffer -- extraneous end-fold mark"))
      (fold-top-level)
      (widen)
      (goto-char 1)
      ;; Do the modifications forwards.
      (fold-change-visibility (nreverse (cdr fold-list)) nil))
    ;; Don't use `save-excursion' here; leave the point somewhere
    ;; visible if an error occurs.
    (let ((pt (point)))
      (beginning-of-line)
      (fold-narrow-to-region nil nil t)
      (fold-goto-char pt depth))
    (message "Folding buffer... done")))

;;}}}
;;{{{ fold-open-buffer

;; This must not depend on the fold stack being correct: it is called by
;; overloaded functions to get the buffer into a known state after some
;; package has called `widen'.

(defun fold-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)
  (or folding-mode
      (error "fold-open-buffer: Folding mode is not active"))
  (message "Unfolding buffer...")
  (fold-clear-stack)
  (fold-set-mode-line)
  (unwind-protect
      (progn
	(widen)
	(fold-change-visibility (list 1 (point-max)) t))
    (fold-narrow-to-region nil nil t))
  (message "Unfolding buffer... done"))

;;}}}
;;{{{ fold-remove-folds

(defun fold-remove-folds (&optional buffer pre-title post-title pad)
  "Removes 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? ")))
  (or folding-mode
      (error "fold-remove-folds: Folding mode is not active"))
  (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)
					       "*")))
	(old-buffer (current-buffer))
	(section-list '(1))
	(section-prefix-list '(""))
	title
	(secondary-mark-length (length fold-secondary-top-mark))
	(regexp fold-regexp)
	(secondary-mark fold-secondary-top-mark)
	prefix
	(mode major-mode))
    (fold-cc buffer-disable-undo
	(buffer-disable-undo new-buffer)
      (buffer-flush-undo new-buffer))
    (save-restriction
      (widen)
      (set-buffer new-buffer)
      (erase-buffer)
      (funcall mode)
      (insert-buffer-substring old-buffer))
    (fold-change-visibility (list 1 (point-max)) t)
    (display-buffer new-buffer t)
    (goto-char (point-min))
    (while (re-search-forward regexp nil t)
      (if (match-beginning 4)
	  (progn
	    (goto-char (match-end 4))
	    (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.")))

;;}}}

;;}}}
;;{{{ Wrappers for standard functions, prefixed with `fold-'

;;{{{ fold-goto-char

(fold-cc text-properties
    (defalias 'fold-goto-char 'goto-char)
  (defun fold-goto-char (pos &optional noenter)
    "Set point to POS, exiting and entering folds as necessary.
After moving to the specified position, if Folding mode is active, as
many folds as possible are entered so that the point is not in a hidden
region.  If Folding mode is inactive, this is the same as `goto-char'.

Optional second arg  NOENTER says how to enter folds.
  nil -- means enter as many folds as possible.
  t   -- means enter as few folds as possible to avoid being in hidden text.
  num -- any integer means to stop entering at that depth, provided this
         lies between the minimum and maximum allowable values."
    (interactive "nGoto char: ")
    (if (not folding-mode)
	(goto-char pos)
      ;; Sometimes this is called after the buffer is widened, by
      ;; another package that doesn't know about folding mode.
      ;; We can't intercept it, because `widen' has a byte-code.
      ;; Just delete the fold-stack in this case.
      (and (= (point-min) 1)
	   (= (point-max) (1+ (buffer-size)))
	   (setq fold-stack nil))
      (while (and fold-stack
		  (or (< pos (point-min))
		      (> pos (point-max))))
	(fold-exit))
      (goto-char pos)
      (fold-enter t noenter))))

;;}}}
;;{{{ fold-goto-line

(fold-cc text-properties
    (defalias 'fold-goto-line 'goto-line)
  (defun fold-goto-line (line)
    "Go to line ARG.  In Folding mode, enters the fold that is found."
    (interactive "nGoto line: ")
    (if (not folding-mode)
	(goto-line line)
      (let (where)
	(save-excursion
	  (save-restriction
	    (widen)
	    (goto-char (point-min))
	    (and (< 1 line)
		 (re-search-forward "[\n\r]" nil 0 (1- line)))
	    (setq where (point))))
	(fold-goto-char where)))))

;;}}}
;;{{{ fold-count-lines

;; Not an interactive function.  This is a replacement for `count-lines'
;; which works in selective-display (counting newlines and carriage
;; returns).  It used by various interactive functions to count lines,
;; temporarily replacing the definition of `count-lines' while calling
;; some function.

(fold-cc text-properties
    nil
  (fold-cc count-lines-selective-display
      nil
    ;; `count-lines' doesn't handle selective-display properly.
    ;; Replace it with one that does.  Replacing it like this makes
    ;; all the related functions, `what-line' etc., work correctly.
    (fset 'count-lines 'fold-count-lines)
    (defun fold-count-lines (start end)
      "Return number of lines between START and END.
This is usually the number of newlines between them,
but can be one more if START is not equal to END
and the greater of them is not at the start of a line.
With selective-display, also counts carriage-returns."
      (save-match-data
	(save-excursion
	  (save-restriction
	    (narrow-to-region start end)
	    (goto-char (point-min))
	    (if (eq selective-display t)
		(let ((done 0))
		  (while (re-search-forward "[\n\C-m]" nil t 40)
		    (setq done (+ 40 done)))
		  (while (re-search-forward "[\n\C-m]" nil t 1)
		    (setq done (+ 1 done)))
		  ;; If (not (eobp)), the last sucessful search did not
		  ;; not finish just after a linefeed/CR, and the region
		  ;; isn't empty, so the condition for adding 1 is
		  ;; satisfied.
		  (if (eobp) done (1+ done)))
	      (- (buffer-size) (forward-line (buffer-size))))))))))

;;}}}

;;{{{ fold-subst-in-form

;; (fold-subst-in-form SUBSTITUTIONS BODY)
;; 
;; This macro expands to a form which, when evaluated, returns BODY with
;; some symbols replaced by other forms.  SUBSTITUTIONS is a list of
;; pairs (SYMBOL REPLACEMENT-FORM), or triples (SYMBOL REPLACEMENT-FORM
;; t).  The REPLACEMENT-FORMS are evaluated when the expansion of this
;; macro is evaluated.  The result of substituting in BODY is also
;; evaluated at this time.  Lists are scanned recursively, but not
;; vectors.  Where a substutition is given as a triple ending in `t',
;; that means to continue substituting in REPLACEMENT-FORM.  The default
;; is not to substitute in that.
;; 
;; This is useful in macro definitions, as a more readable alternative
;; to the backquote mechanism.

(defmacro-compile-only fold-subst-in-form (substitutions body)
  (let* (temp
	 (recurse (function
		   (lambda (body)
		     (cond ((consp body)
			    ;; Traverse a list with a loop rather than
			    ;; recursion, because the latter leads exceeds
			    ;; max-lisp-eval-depth rather quickly.
			    (let* ((tmp (list (funcall recurse (car body))))
				   (result tmp))
			      (while (and (setq body (cdr body))
					  (consp body))
				(setq tmp
				      (setcdr tmp
					      (list (funcall recurse
							     (car body))))))
			      (setcdr tmp (funcall recurse body))
			      result))
			   ((symbolp body)
			    (if (setq temp (assq body substitutions))
				(if (nth 2 temp)
				    (funcall recurse (nth 1 temp))
				  (nth 1 temp))
			      body))
			   (t
			    body)))))
	 (substitutions (list (list 'RECURSE recurse)
			      (list 'SUBST substitutions)
			      (list 'BODY body))))
    (funcall recurse '(let* (temp
			     (recurse 'RECURSE)
			     (substitutions
			      (mapcar '(lambda (arg)
					 (list (car arg)
					       (eval (nth 1 arg))
					       (nth 2 arg)))
				      'SUBST)))
			(funcall recurse BODY)))))

;;}}}

(defvar fold-overload-list ())

;;{{{ fold-overload

;; Set the function value of NAME to VALUE, saving the original binding
;; of NAME so that it can be restored by `fold-cancel-overloads', or at
;; the end of a `(fold-save-overloads...)' form.

(defun fold-overload (name &optional value)
  (let ((inhibit-quit t)
	(saved-name (intern (concat "fold-saved-function:"
				    (symbol-name name))))
	(value (or value (intern (concat "fold-" (symbol-name name))))))
    (or (fboundp saved-name)
	(progn
	  (setq fold-overload-list (cons (cons name saved-name)
					 fold-overload-list))
	  (fset saved-name (if (fboundp name)
			       (symbol-function name)
			     'void-function))
	  (fset name value)))))

;;}}}
;;{{{ fold-cancel-overloads

;; Undo all the function overloadings done by `fold-overload'.  If this
;; is called inside a `(fold-save-overloads...)' form, undoes only those
;; calls to `fold-overload' that occurred within the form.

(defun fold-cancel-overloads ()
  (let ((inhibit-quit t)
	temp value)
    (while fold-overload-list
      (setq temp (car fold-overload-list))
      (and (fboundp (cdr temp))
	   (progn
	     (if (eq 'void-function (setq value (symbol-function (cdr temp))))
		 (fmakunbound (car temp))
	       (fset (car temp) value))
	     (fmakunbound (cdr temp))))
      ;; Remove the element from the list after the overloading
      ;; has definitely been removed.
      (setq fold-overload-list (cdr fold-overload-list)))))

;;}}}
;;{{{ fold-save-overloads

(put 'fold-save-overloads 'lisp-indent-function 0)

(defmacro fold-save-overloads (&rest body)
  (fold-subst-in-form ((BODY body))
    '(let ((inhibit-quit t)
	   fold-overload-list)
       (unwind-protect
	   (let ((inhibit-quit nil))
	     . BODY)
	 (fold-cancel-overloads)))))

;;}}}
;;{{{ fold-extend-function

(put 'fold-extend-function 'lisp-indent-function 'defun)

(defmacro fold-extend-function (name &rest body)
  (let ((doc (and (stringp (car body)) (car body))))
    (fold-subst-in-form
	((NAME name)
	 (FOLD-NAME
	  (intern (concat "fold-" (symbol-name name))))
	 (SAVED-NAME
	  (intern (concat "fold-saved-function:" (symbol-name name))))
	 (DOC doc)
	 (BODY (if doc (cdr body) body) t)
	 (CALL-ORIGINAL
	  '(let ((fold-saved-name
		  (if (fboundp 'SAVED-NAME) 'SAVED-NAME 'NAME)))
	     (if (not (interactive-p))
		 (apply fold-saved-name fold-args)
	       (unwind-protect
		   (call-interactively
		    fold-saved-name
		    (and (eq 'FOLD-NAME (car-safe (car-safe command-history)))
			 (progn (setq command-history (cdr command-history))
				t)))
		 (let ((cell (car-safe command-history)))
		   (and (eq 'NAME (car-safe cell))
			(setcar cell 'FOLD-NAME))))))
	  t))
      (if doc '(defun FOLD-NAME (&rest fold-args)
		 DOC
		 (interactive)
		 . BODY)
	'(defun FOLD-NAME (&rest fold-args)
	   (interactive)
	   . BODY)))))

;;}}}
;;{{{ fold-eval-after-provide

;; (fold-eval-after-provide FEATURE FORMS...).
;; Similar to `eval-after-load', except that there can be multiple FORMS
;; which are automatically quoted, and the forms are evaluated whenever
;; (provide 'FEATURE) is evaluated.  FEATURE must be a symbol, not a string.
;; If the feature has already been provided, the forms are run immediately
;; (they are still run if (provide 'FEATURE) is evaluated again).
;;
;; This is similar to the behaviour of `eval-after-load' in GNU Emacs 19.29.
;; Unfortunately, Emacs 19.28 and earlier don't evaluate the form if the
;; file has already been loaded.

(put 'fold-eval-after-provide 'lisp-indent-function 'defun)

(defvar fold-after-provide-alist nil)

(defmacro fold-eval-after-provide (feature &rest forms)
  (list 'fold-eval-after-provide-1
	(if (stringp feature) (intern feature) feature)
	(list 'quote (cons 'progn forms))))

;; `rassoc' was introduced in 19.29.  `rassq' is older.

(defun fold-eval-after-provide-1 (feature forms)
  (or (rassq forms fold-after-provide-alist)
      (progn
	(setq fold-after-provide-alist
	      (cons (cons feature forms)
		    fold-after-provide-alist))
	(and (featurep feature)
	     (eval forms)))))

(fold-extend-function provide
  CALL-ORIGINAL
  (let ((tmp fold-after-provide-alist))
    (while tmp
      (and (eq (car (car tmp)) (car fold-args))
	   (eval (cdr (car tmp))))
      (setq tmp (cdr tmp)))))

(fold-overload 'provide)

;;}}}

;;{{{ Modify functions from: compile.el

;; Can't overload `beginning-of-line' because it's byte-compiled (as
;; forward-line).  compile.el calls it.  Oh well, we'll have to make
;; `widen' get rid of the ^Ms instead.  (Similar tricks for etags.el).

(fold-eval-after-provide 'compile
  (fold-extend-function next-error
    (fold-save-overloads
      (fold-overload 'compilation-goto-locus)
      (fold-overload 'compilation-find-file)
      CALL-ORIGINAL))
  (fold-extend-function compilation-goto-locus
    CALL-ORIGINAL
    (and folding-mode
	 (progn
	   (fold-open-buffer) ;; Account for `widen' called by compile.
	   (fold-whole-buffer))))
  (fold-extend-function compilation-find-file
    (let ((buffer CALL-ORIGINAL))
      (and buffer
	   (save-excursion
	     (set-buffer buffer)
	     (and folding-mode
		  (fold-open-buffer))))
      buffer))
  (fold-overload 'next-error))

;;}}}
;;{{{ Modify functions from: etags.el

(fold-eval-after-provide 'etags
  ;; This can call `goto-char' and `widen', if it pops a tag from the history.
  (fold-extend-function find-tag-noselect
    (let ((buffer CALL-ORIGINAL))
      (save-excursion
	(set-buffer buffer)
	(and folding-mode
	     (fold-open-buffer) ;; Account for `widen' called by etags.
	     (fold-whole-buffer)))
      buffer))
  ;; Tag-finding functions call this.
  (fold-extend-function etags-goto-tag-location
    CALL-ORIGINAL
    (and folding-mode
	 (save-excursion
	   (eq (point)
	       (progn
		 (goto-char (match-beginning 0))
		 (beginning-of-line)
		 (point))))
	 (fold-goto-char (match-beginning 0))))
  ;; Tag-searching functions call this.
  (fold-extend-function tags-loop-continue
    CALL-ORIGINAL
    (and folding-mode
	 (progn
	   (fold-open-buffer) ;; Account for `widen' called by etags.
	   (fold-whole-buffer))))
  (fold-overload 'find-tag-noselect)
  (fold-overload 'etags-goto-tag-location)
  (fold-overload 'tags-loop-continue))

;;}}}
;;{{{ Modify functions from: gud.el

(fold-eval-after-provide 'gud
  (fold-extend-function gud-display-line
    (fold-save-overloads
      (fold-overload 'goto-line)
      CALL-ORIGINAL))
  (fold-overload 'gud-display-line))

;;}}}

;;{{{ Modify internal function: eval-buffer

(fold-extend-function eval-buffer
  "Evaluate all of a folded buffer as Lisp code.

Unlike the built in `eval-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."
  (if folding-mode
      (let ((fold-temp-buffer (generate-new-buffer (buffer-name)))
	    fold-suppress-done-message)
	(message "Evaluating unfolded buffer...")
	(save-restriction
	  (widen)
	  (copy-to-buffer fold-temp-buffer 1 (point-max)))
	(set-buffer fold-temp-buffer)
	(fold-change-visibility (list 1 (point-max)) t)
	(fold-save-overloads
	  (fold-overload 'message 
			 (function
			  (lambda (&rest args)
			    (setq fold-suppress-done-message t)
			    (fset 'message (symbol-function
					    'fold-saved-function:message))
			    (apply 'message args))))
	  (unwind-protect
	      CALL-ORIGINAL
	    (kill-buffer fold-temp-buffer)))
	(or fold-suppress-done-message
	    (message "Evaluating unfolded buffer...done")))
    CALL-ORIGINAL))

;;(fold-overload (if (fboundp 'eval-buffer) 'eval-buffer 'eval-current-buffer)
;;	       'fold-eval-buffer)

;;}}}

;;{{{ fold-make-function

;;{{{ Description

;; (fold-make-function NAME ORIGINAL OPTIONS DOCSTRING &rest BINDINGS)

;; Makes new functions from old ones.  The new function has the same
;; interactive specification as the old one, the same documentation
;; string but with a bit more appended.  The new function calls the old
;; one with some functions rebound using `fold-rebind-functions';
;; BINDINGS is the list of functions to rebind.

;; OPTIONS is a list of extra things to be done:

;; `goto' means after calling the original function, call
;; `fold-goto-char' to exit and enter folds as necessary.

;; `widen' means widen the buffer and make it read-only temporarily.

;; `all-widen' means widen *every* buffer that is folded, and make them
;; all read-only, temporarily.  This is all quite horrible, but is the
;; best I can think of for commands which might switch to an arbitrary
;; folded buffer; we can't rebind `set-buffer' because it is a
;; byte-code.  `widen' and `all-widen' cannot be used together.

;; If `folding-mode' is nil when the new function is called, the
;; original is called without a special environment.

;; The new function takes `&rest args'; we don't examine or presume how
;; to call the original function.  This is because someone might modify
;; the argument list in a future Emacs version.  We use
;; `call-interactively' to call the function, if we were called
;; interactively.  We update the history list `command-history' in that
;; case, because the user really wanted to call the new function.

;; If this is the text-properties version, we just copy the function
;; definition directly.  The new functions are thus obsolete, but we
;; keep them around anyway.

;;}}}

(defmacro-compile-only fold-make-function
  (original options docstring &rest bindings)
  (let ((name (intern (concat "fold-" (symbol-name original)))))
    (fold-cc text-properties
	(` (progn
	     (defalias '(, name) '(, original))
	     (make-obsolete '(, name) '(, original))))
      (let ((call (macroexpand
		   (` (fold-rebind-functions (, bindings)
			(if (not (interactive-p))
			    (apply '(, original) args)
			  (unwind-protect
			      (call-interactively
			       '(, original)
			       (and (eq '(, name) (car-safe
						   (car-safe command-history)))
				    (setq command-history (cdr command-history)
					  ;; Force non-nil return.
					  args t)))
			    (let ((cell (car-safe command-history)))
			      (and (eq '(, original) (car-safe cell))
				   (setcar cell '(, name)))))))))))
	;; Wrap for goto:
	(and (memq 'goto options)
	     (setq call (` (let* ((inhibit-quit t)
				  (saves (fold-record-buffer-values
					  (buffer-list))))
			     (unwind-protect
				 (let* ((saves saves)
					inhibit-quit)
				   (, call))
			       (let ((point (point))
				     (buf (current-buffer)))
				 (unwind-protect
				     (fold-restore-buffer-values saves)
				   (set-buffer buf)
				   (fold-goto-char point))))))))
	;; Wrap for widen and all-widen:
	(and (or (memq 'widen options)
		 (memq 'all-widen options))
	     (setq call (` (let* ((inhibit-quit t)
				  (saves (fold-widen-buffers
					  (, (if (memq 'all-widen options)
						 '(buffer-list)
					       '(list (current-buffer)))))))
			     (unwind-protect
				 (let* ((saves saves)
					inhibit-quit)
				   (, call))
			       (fold-restore-buffers saves))))))
	(` (fset '(, name)
		 (function
		  (lambda (&rest args)
		    (, (concat (documentation original) "\n" docstring))
		    (interactive)
		    (, call)))))))))

;;}}}
;;{{{ fold-record-buffer-values

;; Goes through all buffers in a list BUFFERS.  If `folding-mode' is nil
;; in a buffer, the buffer is ignored; otherwise: Records the narrowed
;; and read-only states, the value of point (as a marker), and the value
;; of `fold-stack', and returns a list of these records.  If WIDEN is
;; non-nil, widens all the buffers on the way, and clears the value of
;; `fold-stack' (it is still saved).  If READ-ONLY is non-nil, makes all
;; the affected buffers read-only.

;; Insert-before type markers are used (if available) for the point and
;; end of narrowed region.

(defun fold-record-buffer-values (buffers &optional widen read-only)
  (let (saves)
    (while buffers
      (set-buffer (car buffers))
      (and folding-mode
	   (progn
	     (setq saves (cons (list (car buffers)
				     (fold-cc marker-types
					 ;; Insert-before type of marker.
					 (set-marker-type (point-marker) t)
				       (point-marker))
				     (and (/= 1 (point-min))
					  (point-min-marker))
				     (and (/= (1+ (buffer-size))
					      (point-max))
					  (fold-cc
					      marker-types
					      (set-marker-type
					       (point-max-marker) t)
					    (point-max-marker)))
				     buffer-read-only
				     (and (boundp 'fold-stack) fold-stack))
			       saves)))
	   (and read-only
		(setq buffer-read-only t))
	   (and widen
		(progn
		  (setq fold-stack nil)
		  (widen))))
      (setq buffers (cdr buffers)))
    saves))

;;}}}
;;{{{ fold-restore-buffer-values

;; Using a result from `fold-record-buffer-values', goes through some
;; buffers restoring the folded status, the narrowed status (if the
;; buffer is still widened), *and point*.  Restores the read-only flag.

(defun fold-restore-buffer-values (saves)
  (while saves
    (let ((inhibit-point-motion-hooks t)
	  data)
      (setq data (car saves)
	    saves (cdr saves))
      (set-buffer (car data))
      (and (eq 1 (point-min))
	   (eq (1+ (buffer-size)) (point-max))
	   (narrow-to-region (or (nth 2 data) 1)
			     (or (nth 3 data) (1+ (buffer-size)))))
      (goto-char (nth 1 data))
      (set-marker (nth 1 data) nil)
      (and (nth 2 data) (set-marker (nth 2 data) nil))
      (and (nth 3 data) (set-marker (nth 3 data) nil))
      (setq buffer-read-only (nth 4 data))
      (and (nth 5 data)
	   (setq fold-stack (nth 5 data))))))

;;}}}

;;{{{ fold-next-error

;;;(fold-make-function next-error (all-widen goto)
;;;  "If Folding mode is active, enters as many folds as possible,
;;;so that the point is not left in hidden text.")

;;}}}

;;}}}
;;{{{ Tags support

;; These are just functions used internally.

;;{{{ fold-tags-beginning-of-line

;; The tags function wrappers need this.

;;(defun fold-tags-beginning-of-line (&optional arg)
;;  (interactive "p")
;;  (if (or arg (not folding-mode))
;;      (fold-fsaved-beginning-of-line arg)
;;    (skip-chars-backward "^\r\n")))

;;}}}
;;{{{ fold-tags-re-search-forward

;; Like `re-search-forward', but modifies the regexp so that `^' and `$'
;; also match carriage returns.  This messes up the matched-data, so we
;; do a `looking-at' if we matched, with another regexp.  We're only
;; going to use this function in the tags search commands.  Hope for the
;; best!  This isn't a very thorough function.  We make the effort to get
;; the match-data right because it might be being used in a
;; `tags-query-replace'.  It would be easier just to change the tags.el
;; package.

;(defun fold-tags-re-search-forward (regexp &optional lim flag count)
;  (if (and folding-mode
;	   (not (string-equal "" regexp)))
;      (let (new-regexp result anchor-beg anchor-end)
;	(and (eq ?$ (string-to-char (substring regexp -1)))
;	     (setq anchor-end t
;		   regexp (concat (substring regexp 0 -1) "\\($\\|\r\\)")))
;	(setq new-regexp regexp)
;	(and (eq ?^ (string-to-char regexp))
;	     (setq anchor-beg t
;		   regexp (substring regexp 1)
;		   new-regexp (concat "\\(^\\|\r\\)" regexp)))
;	;; new-regexp has ^Ms substituted at both ends.
;	;; regexp now has the `^' completely removed at the start.
;	(save-restriction
;	  (setq lim (if lim (max lim (point-max)) (point-max)))
;	  (widen)			; Leave room for ^M before narrowed.
;	  (and anchor-beg
;	       (eq (preceding-char) ?\r)
;	       (forward-char -1))
;	  (and anchor-end
;	       (eq (char-after lim) ?\r)
;	       (setq lim (1+ lim)))
;	  (setq result
;		(fold-fsaved-re-search-forward new-regexp lim flag count))
;	  (if result
;	      (progn
;		(goto-char (match-beginning 0))
;		(and anchor-beg
;		     (eq (following-char) ?\r)
;		     (forward-char 1))
;		(looking-at regexp)	; Get the match-data right.
;		(goto-char (match-end 0))
;		t)
;	    (and anchor-end
;		 (eq (point) lim)
;		 (forward-char -1))
;	    nil)))
;    (fold-fsaved-re-search-forward regexp lim flag count)))

;;}}}

;; These are folding equivalents of some interactive tags functions.

;;{{{ fold-find-tag

;(fold-make-function find-tag (goto)
;  "If Folding mode is active, enters as many folds as possible,
;so that the point is not left in hidden text."
;  (re-search-forward fold-tags-re-search-forward)
;  (beginning-of-line fold-tags-beginning-of-line))

;;}}}
;;{{{ fold-find-tag-other-window

;(fold-make-function find-tag-other-window (goto)
;  "If Folding mode is active, enters as many folds as possible,
;so that the point is not left in hidden text."
;  (re-search-forward fold-tags-re-search-forward)
;  (beginning-of-line fold-tags-beginning-of-line))

;;}}}
;;{{{ fold-tags-search

;(fold-make-function tags-search (goto)
;  "If Folding mode is active, enters as many folds as possible,
;so that the point is not left in hidden text."
;  (re-search-forward fold-tags-re-search-forward)
;  (beginning-of-line fold-tags-beginning-of-line))

;;}}}
;;{{{ fold-tags-apropos

;(fold-make-function tags-apropos (goto)
;  "If Folding mode is active, enters as many folds as possible,
;so that the point is not left in hidden text."
;  (re-search-forward fold-tags-re-search-forward)
;  (beginning-of-line fold-tags-beginning-of-line))

;;}}}
;;{{{ fold-tags-query-replace

;(fold-make-function tags-query-replace (goto)
;  "If Folding mode is active, enters as many folds as possible,
;so that the point is not left in hidden text."
;  (re-search-forward fold-tags-re-search-forward)
;  (beginning-of-line fold-tags-beginning-of-line))

;;}}}
;;{{{ fold-tags-loop-continue

;(fold-make-function tags-loop-continue (goto)
;  "If Folding mode is active, enters as many folds as possible,
;so that the point is not left in hidden text."
;  (re-search-forward fold-tags-re-search-forward)
;  (beginning-of-line fold-tags-beginning-of-line))

;;}}}

;;}}}

;;}}}
;;{{{ Standard fold marks for various major modes

;; These functions, and especially the list of default marks, will be
;; replaced by a better method soon.

;;{{{ A function to set default marks, `fold-add-to-marks-list'

(defun fold-add-to-marks-list (mode top bottom
				    &optional secondary noforce message)
  "Add/set fold marks 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
`fold-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:

\(fold-add-to-marks-list 'major-mode \"(** {{{ \" \"(** }}} **)\" \" **)\")

Look at the variable `fold-mode-marks-alist' to see what default settings
already apply.

`fold-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 fold-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 fold-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 fold-mode-marks-alist
	      (cons (if secondary
			(list mode top bottom secondary)
		      (list mode top bottom))
		    fold-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)
		  (fold-set-marks top bottom secondary))))))

;;}}}
;;{{{ Set some useful default fold marks

(fold-add-to-marks-list 'emacs-lisp-mode       ";;{{{ " ";;}}}" nil t)
(fold-add-to-marks-list 'lisp-interaction-mode ";;{{{ " ";;}}}" nil t)
(fold-add-to-marks-list 'lisp-mode             ";;{{{ " ";;}}}" nil t)
(fold-add-to-marks-list 'scheme-mode           ";;{{{" ";;}}}" nil t)

(fold-add-to-marks-list 'fortran-mode "c {{{ " "c }}}" nil t)
(fold-add-to-marks-list 'elec-c-mode "/* {{{ " "/* }}} */" " */" t)
(fold-add-to-marks-list 'bison-mode "/* {{{ " "/* }}} */" " */" t)
(fold-add-to-marks-list 'Bison-mode "/* {{{ " "/* }}} */" " */" t)

(fold-add-to-marks-list 'texinfo-mode "@c <<< " "@c >>>" nil t)

;; This is a very old, very poor choice:
;;(fold-add-to-marks-list 'texinfo-mode "@c {{{ " "@c {{{endfold}}}" " }}}" t)

;;	Bison-mode
;;	emacs-lisp-mode			;;{{{		;;}}}
;;	lisp-interaction-mode		;;{{{		;;}}}
;; lisp-mode

;; Here are some extension packages I've checked:
;;
;;      matlab-mode (some versions)	{{{		}}}
;;      matlab-mode (other versions)	%{{{		%}}}
;;	erlang-mode			%{{{		%}}}

;; Erlang mode, like Lisp modes, indents "%% ..." differently ;; to "% ...".
(fold-add-to-marks-list 'erlang-mode "%%{{{ " "%%}}}" nil t)
;; Some Matlab modes don't define comment-start.
(fold-add-to-marks-list 'matlab-mode "%%%{{{ " "%%%}}}" nil t)
;; Texinfo mode isn't happy with "{{{" in fold marks.
(fold-add-to-marks-list 'texinfo-mode "@c <<< " "@c >>>" nil t)
;; Pascal already has "{" as its comment delimiter!
;; I don't like these marks (poor visibility) but Anders Lindgren chose them.
(fold-add-to-marks-list 'pascal-mode "{ ((( " "{ ))) }" "}" t)


;; Anders Lindgren has:

;;	fundamental-mode		# {{{		# }}}
;;	dcl-mode			! {{{		! }}}
;;	fortran-mode			! {{{		! }}}
;;	f90-mode			! {{{		! }}}
;;	generic-mode			;#		;$
;;	erlang-mode			%%{{{		%%}}}
;;	html-mode			<!-- [[[  -->	<!-- ]]] -->
;;	m4-mode				# {{{		# }}}
;;	makefile-mode			# {{{		# }}}
;;	matlab-mode			%%%{{{		%%%}}}
;;	makefile-mode			% {{{		% }}}
;;	ml-mode				(* {{{  *)	(* }}} *)
;;	nroff-mode			\\ {{{		\\ }}}
;;	pascal-mode			{ (((  }	{ ))) }
;;	prolog-mode			% {{{		% }}}
;;	sgml-mode			<!-- [[[  -->	<!-- ]]] -->
;;	simula-mode			! {{{		! }}}
;;	sql-mode			-- {{{		-- }}}
;;	tcl-mode			#{{{		#}}}
;;	texinfo-mode			@c {{{  }}}	@c {{{endfold}}}
;;	vhdl-mode			# {{{		# }}}
;;	xerl-mode			%%{{{		%%}}}
;;
;; The default algorithm is known to give good fold marks for these modes
;; (some of which don't come with Emacs):
;;
;;	ada-mode			-- {{{		-- }}}
;;	antlr-mode			// {{{		// }}}
;;	asm-mode			# {{{		# }}}
;;	  (asm-mode may use another appropriate comment char)
;;	awk-mode			# {{{		# }}}
;;	bibtex-mode			@Comment {{{	@Comment }}}
;;	bison-mode			/*{{{ */	/*}}}*/
;;	c-mode				/* {{{  */	/* }}} */
;;	c++-mode			// {{{		// }}}
;;	cperl-mode			# {{{		# }}}
;;	dcl-mode			!{{{		!}}}
;;	default-generic-mode		#{{{		#}}}
;;	f90-mode			!{{{		!}}}
;;	flex-mode			/*{{{ */	/*}}}*/
;;	gofer-mode			-- {{{		-- }}}
;;	html-mode			<!-- {{{  -->	<!-- }}} -->
;;	icon-mode			# {{{		# }}}
;;	idl-mode			// {{{		// }}}
;;	indented-text-mode		{{{		}}}
;;	java-mode			// {{{		// }}}
;;	jde-mode			// {{{		// }}}
;;	ksh-mode			# {{{		# }}}
;;	latex-mode, LaTeX-mode		%{{{		%}}}
;;	m4-mode				#{{{		#}}}
;;	makefile-mode			#{{{		#}}}
;;	metafont-mode			%{{{		%}}}
;;	metapost-mode			%{{{		%}}}
;;	ml-mode				(* {{{  *)	(* }}} *)
;;	modula-2-mode			(* {{{  *)	(* }}} *)
;;	objc-mode			// {{{		// }}}
;;	octave-mode			# {{{		# }}}
;;	orwell-mode			{{{		}}}
;;	perl-mode			# {{{		# }}}
;;	pike-mode			# {{{		# }}}
;;	plain-tex-mode, plain-TeX-mode	%{{{		%}}}
;;	prolog-mode			%{{{		%}}}
;;	python-mode			# {{{		# }}}
;;	rexx-mode			/* {{{  */	/* }}} */
;;	sgml-mode			<!-- {{{  -->	<!-- }}} -->
;;	sh-mode				# {{{		# }}}
;;	sh-script-mode			# {{{		# }}}
;;	shellscript-mode		# {{{		# }}}
;;	shell-script-mode		# {{{		# }}}
;;	simula-mode			! {{{  ;	! }}} ;
;;	slitex-mode			%{{{		%}}}
;;	sml-mode			(* {{{  *)	(* }}} *)
;;	sql-mode			--{{{		--}}}
;;	tcl-mode			# {{{		# }}}
;;	tex-mode, TeX-mode		%{{{		%}}}
;;	text-mode			{{{		}}}
;;	verilog-mode			/* {{{  */	/* }}} */
;;	vhdl-mode			--{{{		--}}}
;;	xrdb-mode			! {{{		! }}}
;;
;; The following come from generic.el and generic-x.el:
;;
;;	default-generic-mode		#{{{		#}}}
;;	apache-generic-mode		#{{{		#}}}
;;	samba-generic-mode		;{{{		;}}}
;;	fvwm-generic-mode		#{{{		#}}}
;;	x-resource-generic-mode		!{{{		!}}}
;;	hosts-generic-mode		#{{{		#}}}
;;	inf-generic-mode		;{{{		;}}}
;;	ini-generic-mode		;{{{		;}}}
;;	reg-generic-mode		;{{{		;}}}
;;	mailagent-rules-generic-mode	#{{{		#}}}
;;	prototype-generic-mode		#{{{		#}}}
;;	pkginfo-generic-mode		#{{{		#}}}
;;	javascript-generic-mode		//{{{		//}}}
;;	vrml-generic-mode		#{{{		#}}}
;;	java-manifest-generic-mode	#{{{		#}}}
;;	java-properties-generic-mode	#{{{		#}}}
;;	alias-generic-mode		#{{{		#}}}
;;	rc-generic-mode			//{{{		//}}}
;;	rul-generic-mode		//{{{		//}}}
;;	mailrc-generic-mode		#{{{		#}}}
;;
;; These are hideous defaults that the algorithm would churn out:
;;
;;	dsssl-mode			;{{{		;}}}
;;	emacs-lisp-mode			;{{{		;}}}
;;	lisp-mode			;{{{		;}}}
;;	lisp-interaction-mode		;{{{		;}}}
;;	nroff-mode			\" {{{		\" }}}
;;	scheme-mode			;{{{		;}}}
;;	texinfo-mode			@c {{{		@c }}}
;;	fortran-mode			{{{		}}}
;;

;; Fortran mode (not F90 mode).  In Fortran mode comment-start is not
;; defined by default, so the fold marks default to "{{{" and "}}}"
;; which are wrong.  Suitable marks are "C {{{" and "C }}}", but unlike
;; other languages, the "C" _must_ occur in column 1 to be recognised as
;; a Fortran comment.
;;
;; The normal fold creation function will indent the "C {{{".
;;
;; Sometimes, comment-start is defined as "!", in which case folding
;; works just like other modes.
;;
;; Check subtleties with fortran-mode (c vs. !).
;;
;;    c-mode, c++-mode, c++-c-mode, cc-c++-mode, cc-c-mode

;;}}}

;;}}}
;;{{{ Start Folding mode automatically for folded files

;;{{{ folding-mode-find-file-hook

;; This should really work out the fold marks from the major mode and
;; search for those.  `{{{' and `}}}' aren't always appropriate.

(defun folding-mode-find-file-hook ()
  "One of the hooks called whenever a `find-file' is successful.

See `folding-mode-add-find-file-hook'.

Note that this function is most effective when it is placed
at the *end* of `find-file-hooks'
;; so that the text can be
folded after other processing.  (For example, the text may
need to be decompressed first, or some special editing mode
may need to be started)."
  (if (or (and (assq 'folded-file (buffer-local-variables))
	       folded-file)
	  (save-excursion
	    (goto-char (point-min))
	    (search-forward "{{{" (max (point-max) (+ (point-min) 4000)) t))
	  (save-excursion
	    (goto-char (point-max))
	    (search-backward "}}}" (min (point-min) (- (point-max) 4000)) t)))
      (folding-mode 1))
  (kill-local-variable 'folded-file))

;;}}}
;;{{{ folding-mode-add-find-file-hook

;;;###autoload
(defun folding-mode-add-find-file-hook ()
  "Appends `folding-mode-find-file-hook' to the list `find-file-hooks'.

This enables checks to see if Folding mode should be turned
on when visiting files.  Any of the following conditions
will cause Folding mode to be turned on automatically:

1. If `folded-file' is set in the file's local variables, to
   a non-nil value, such as `t'.  (File local variables are
   documented in the Emacs manual, under \"File Variables\").

2. If the string `{{{' is found within 4000 characters of
   the beginning of the buffer.

3. If the string `}}}' is found within 4000 characters of
   the end of the buffer.

This allows most folded files to be automatically folded
when opened.

You can enable this behaviour by placing the following text
in your \".emacs\" file:

  (folding-mode-add-find-file-hook)

Note that in Emacs 19, if `enable-local-variables' is nil,
the file's local variables are ignored.  In Emacs 18,
`inhibit-local-variables' has a similar, but converse
effect.  File local variables can be inside a fold."
  (interactive)
  (or (memq 'folding-mode-find-file-hook find-file-hooks)
      (setq find-file-hooks (append find-file-hooks
				    '(folding-mode-find-file-hook)))))

;;}}}

;;}}}
;;{{{ Gross, crufty hacks that seem necessary

;; The functions here have been tested with GNU Emacs 18.55-18.59; GNU
;; Emacs 19.16-19.31; Epoch 4.0p2 (based on Emacs 18.58); and Lucid
;; Emacs 19.6.

;; Note that Lucid Emacs 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.

;;{{{ fold-merge-keymaps

;; Not used when minor-mode-keymaps are available (i.e., FSF Emacs 19).

;; In Lucid, copies EXTRA, and makes the copy's parent be MAP.  Returns
;; the copy.  Otherwise:

;; Takes two keymaps, MAP and EXTRA.  Merges each binding in EXTRA into
;; a copy of MAP, and returns the new keymap (bindings in EXTRA override
;; those in MAP).  MAP or EXTRA may be nil, indicating an empty keymap.
;; If they are both nil, nil is returned.  Sub-keymaps and even cons
;; cells containing bindings are not copied unnecessarily (well,
;; sometimes they are).  This means that if you modify the local map
;; when Folding mode is active, the effects are unpredictable: you may
;; also affect the keymap that was active before Folding mode was
;; started, and you may affect `folding-mode-map'.

(fold-cc minor-mode-maps
    nil
  (defun fold-merge-keymaps (map extra)
    (or map (setq map extra extra nil))
    (fold-cc lucid-keymaps
	(if (null extra)
	    map
	  (let ((new (copy-keymap extra)))
	    (set-keymap-parent new map)
	    new))
      (if (null extra)
	  (and map (copy-keymap map))
	(or (keymapp extra)
	    (signal 'wrong-type-argument (list 'keymapp extra)))
	(or (keymapp map)
	    (signal 'wrong-type-argument (list 'keymapp map)))
	(and (vectorp extra)
	     (let ((key (length extra))
		   (oldextra extra))
	       (setq extra nil)
	       (while (<= 0 (setq key (1- key)))
		 (and (aref oldextra key)
		      (setq extra (cons (cons key (aref oldextra key))
					extra))))
	       (setq extra (cons 'keymap extra))))
	(and (cdr extra)
	     (let (key keycode cons-binding realdef def submap)

	       ;; Note that this copy-sequence will copy the spine of
	       ;; the sparse keymap, but it will not copy the cons cell
	       ;; used for each binding.  This is important: define-key
	       ;; does a setcdr to rebind a key, if that key was bound
	       ;; already, so define-key can't be used to change a
	       ;; binding.  Using copy-keymap instead would be excessive
	       ;; and slow, because it would be repeatedly invoked, as
	       ;; this function is called recursively.
	       (setq map (copy-sequence map))

	       (while (setq extra (cdr extra))
		 (setq keycode (car (car extra))
		       key (char-to-string keycode)
		       def (cdr (car extra))
		       realdef def)
		 (while (and def (if (symbolp def)
				     (setq def (symbol-function def))
				   (and (consp def)
					(integerp (cdr def))
					(keymapp (car def))
					(setq def (lookup-key (car def)
							      (char-to-string
							       (cdr def))))))))
		 (if (and (keymapp def)
			  (setq submap (lookup-key map key)))
		     (progn
		       (while (and submap
				   (if (symbolp submap)
				       (setq submap (symbol-function submap))
				     (and (consp submap)
					  (integerp (cdr submap))
					  (keymapp (car submap))
					  (setq submap (lookup-key
							(car submap)
							(char-to-string
							 (cdr submap))))))))
		       (if (keymapp submap)
			   (if (vectorp map)
			       (aset map keycode
				     (fold-merge-keymaps submap def))
			     (setcdr (setq map (delq (assq keycode map) map))
				     (cons
				      (cons keycode
					    (fold-merge-keymaps submap def))
				      (cdr map))))
			 (if (vectorp map)
			     (aset map keycode realdef)
			   (setcdr (setq map (delq (assq keycode map) map))
				   (cons (cons keycode realdef) (cdr map))))))
		   (and def
			(if (vectorp map)
			    (aset map keycode realdef)
			  (and (setq cons-binding (assq keycode map))
			       (setq map (delq cons-binding map)))
			  (setcdr map (cons (cons keycode realdef)
					    (cdr map)))))))))
	map))))

;;}}}
;;{{{ fold-change-visibility

;; This important function changes the visibility of text.

;; Note: When font lock is enabled, this is *the* single bottleneck in
;; all folding operations.  Without font lock this is quite fast,
;; although it is still the most significant time consumer.
;;
;; Overlays may or may not be faster (all those font properties
;; interfere with overlay creation too).  One thing's for sure: when I
;; last checked (in the Emacs 19.xx series), overlays and text
;; properties were much too slow to be used for folding.  _That's_ the
;; reason we're still using selective display.

;; Substitute newlines for carriage returns or vice versa.
;; Avoid creating undo-records.  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.

;; I consider these problems to be a bug in `subst-char-in-region'.

;; Locking is now fully disabled as of version 1.7, so folding
;; unmodified/read-only files is as fast as folding modified ones.

;; Unfortunate experience with overlays and Emacs 20.7
;; ---------------------------------------------------
;;
;; I've experimented with using overlays to hide text.  There is one
;; obvious and surprising problem: invisible overlays display *much*
;; slower than selective display using \r.  Vertical motion is also very
;; slow, regardless of display speed.  Both are too slow to use.
;;
;; To see this, use invisible overlays to hide folds in a large file
;; (say folding.el replicated to 4MB).  Scroll up and down using page or
;; line movement functions, and you will easily see it is much slower
;; than selective display.  On my Pentium II 300MHz, Emacs cannot
;; refresh the screen fast enough to keep up with my page up/down key
;; repeat when using invisible overlays, but with selective display it
;; keeps up smoothly.
;;
;; There is obviously a bug, probably somewhere in Emacs display code.
;; It's been there a long time and I'm surprised nobody tried to find it.
;;
;; Unfortunately, overlays offered a big advantage: different views in
;; different windows.  Ah well, one day.
;;
;; It is possible to use *non*-invisible overlays in conjunction with
;; selective display.  This works quite well and feels as fast as plain
;; selective display.

(defun fold-change-visibility-selective-display (list visible)
  (let ((find (if visible ?\r ?\n))
	(replace (if visible ?\n ?\r)))
    (while list
      (subst-char-in-region (car list) (nth 1 list) find replace t)
      (setq list (cdr (cdr list))))))

(setplist 'fold-overlay '(intangible fold-overlay))

(defvar fold-use-selective-display t)

;; There are still some problems due to the overlay intangibility.
(defvar fold-use-overlays nil)

(defun fold-change-visibility (list visible)
  (let (;; Defeat file locking.  From Emacs 19.30, subst-char-in-region
	;; does this itself.  So I was right :-)
	(buffer-file-name nil)
	;; Paranoia.  Avoid asking the user annoying questions.
	(ask1 (symbol-function 'ask-user-about-supersession-threat))
	(ask2 (symbol-function 'ask-user-about-lock))
	;; Disable change hooks.  Without this, font-lock mode slows
	;; down folding immensely.  (Or alternatively, when this was
	;; added folding sped up immensely :-)  It's also good to disable
	;; the highlight-changes-mode hook, and that's the clue that
	;; says it's probably best to disable all kinds of these hooks.
	before-change-function before-change-functions
	after-change-function after-change-functions
	;; Save modified status.
	(modified (buffer-modified-p))
	;; Make the buffer writable, unless inhibit-read-only works.
	;; inhibit-read-only was introduced in Emacs 19.14.
	(buffer-read-only (and (boundp 'inhibit-read-only) buffer-read-only))
	(inhibit-read-only t)
	;; inhibit-point-motion-hooks was introduced in Emacs 19.18.
	;; It suppresses the effect of intangible properties.
	(inhibit-point-motion-hooks t))
    (unwind-protect
	(progn
	  (or modified
	      (progn
		(fset 'ask-user-about-supersession-threat '(lambda (&rest x)))
		(fset 'ask-user-about-lock '(lambda (&rest x)))
		(set-buffer-modified-p t))) ; Prevent file locking in the loop
	  ;; The actual visibility change is done here.
	  (and fold-use-overlays
	       (fold-change-visibility-overlays list visible))
	  (and (or fold-use-selective-display (not fold-use-overlays))
	       (fold-change-visibility-selective-display list visible)))
      ;; buffer-read-only and buffer-file-name are restored by the let.
      ;; Don't want to change MODIFF time if unnecessary.
      (or modified
	  (unwind-protect
	      (set-buffer-modified-p nil)
	    (fset 'ask-user-about-supersession-threat ask1)
	    (fset 'ask-user-about-lock ask2))))))

(defun fold-change-visibility-overlays (list visible)
  (setq line-move-ignore-invisible t)
  (while list
    (let* ((beg (car list))
	   (end (car (cdr list)))
	   (overlays (overlays-in beg end))
	   this)
      (setq list (cdr (cdr list))
	    beg (save-excursion
		  (goto-char beg)
		  (if (eq selective-display t)
		      (skip-chars-forward "^\r\n")
		    (end-of-line))
		  (point)))
      (while overlays
	(setq this (car overlays)
	      overlays (cdr overlays))
	(if (or (eq (overlay-get this 'category) 'fold-overlay)
		(eq (overlay-get this 'invisible) 'fold-overlay))
	    (if (>= (overlay-start this) beg)
		(if (<= (overlay-end this) end)
		    (delete-overlay this)
		  (move-overlay this end (overlay-end this)))
	      (and (> (overlay-end this) end)
		   (overlay-put (make-overlay end (overlay-end this) nil t)
				'category 'fold-overlay))
	      (move-overlay this (overlay-start this) beg))))
      (or visible
	  (progn
	    (overlay-put (make-overlay beg (if fold-use-selective-display
					       (1+ beg) end)
				       nil t)
			 'invisible 'fold-overlay)
	    (overlay-put (make-overlay beg (if (eq (char-after end) ?\n)
					       (1+ end) end) nil t)
			 'category 'fold-overlay))))))

;;}}}
;;{{{ fold-narrow-to-region

;; Narrow to region, without surprising displays.
;; Simulate narrowing using text-properties if we're using them.
;; (Not yet implemented).

;; 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'.

;; If text-properties are being used for narrowing, it is still useful
;; to adjust the window-starts, otherwise they can lie in a very large
;; region of invisible text, and slow down display unnecessarily.

;; 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 Lucid Emacs, searches all screens for all
;; windows.  In Emacs 19, they are called "frames".

(defun fold-narrow-to-region (&optional start end centre)
  (let* ((the-window (selected-window))
	 (the-screen (fold-cc epoch-screens
			 (epoch::current-screen)))
	 (screens (fold-cc epoch-screens
		      (epoch::screens-of-buffer)))
	 (selected-buffer (window-buffer the-window))
	 (window-ring the-window)
	 (window the-window)
	 (point (point))
	 (buffer (current-buffer))
	 temp)
    (unwind-protect
	(progn
	  ;;{{{ Narrow the region, update point and start in all windows

	  (unwind-protect
	      (progn
		(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)))
			 (fold-cc epoch-screens
			     (or (not (eq (setq window (next-window window))
					  window-ring))
				 (and (setq screens (cdr screens))
				      (setq window (epoch::first-window
						    (car screens))
					    window-ring window)))
			   (not (eq (setq window
					  (fold-cc emacs-frames
					      (next-window window nil t)
					    (fold-cc lucid-screens
						(next-window window nil t t)
					      (next-window window))))
				    window-ring))))))
	    (select-window the-window))

	  ;;}}}
	  ;;{{{ 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)))))

(defvar fold-narrow-overlay-top nil)
(defvar fold-narrow-overlay-bottom nil)

(defun fold-narrow-to-region-overlays (&optional start end centre)
  (if (not start)
      (progn
	(and fold-narrow-overlay-top
	     (delete-overlay fold-narrow-overlay-top))
	(and fold-narrow-overlay-bottom
	     (delete-overlay fold-narrow-overlay-bottom))
	(setq fold-narrow-overlay-top nil
	      fold-narrow-overlay-bottom nil))
    (or fold-narrow-overlay-top
	(progn
	  (overlay-put (set (make-local-variable 'fold-narrow-overlay-top)
			    (make-overlay 1 start))
		       'invisible 'fold-overlay)
	  (overlay-put fold-narrow-overlay-top
		       'window (selected-window))))
    (or fold-narrow-overlay-bottom
	(progn
	  (overlay-put (set (make-local-variable 'fold-narrow-overlay-bottom)
			    (make-overlay end (1+ (buffer-size))))
		       'invisible 'fold-overlay)
	  (overlay-put fold-narrow-overlay-bottom
		       'window (selected-window))))))

;; (fset 'fold-narrow-to-region 'fold-narrow-to-region-overlays)

;;}}}

;;}}}
;;{{{ Clean up when the major mode is changed

;; It is important that Folding mode can clean up its buffer changes
;; when the major mode is changed.  `change-major-mode-hook' is the
;; official hook called when changing major mode.  This was introduced
;; in GNU Emacs 19.23.

;;(add-hook 'change-major-mode-hook 'fold-end-mode-quickly)

;; Two unofficial ways to do the same thing.
;; Standard versions of GNU Emacs prior to 19.23 won't clean up
;; at all, but some extension packages enable this.

(and (boundp 'kill-all-local-variables-hooks)
     (add-hook 'kill-all-local-variables-hooks 'fold-end-mode-quickly))
(put 'folding-mode 'killing-local-variable-function 'fold-end-mode-quickly)

(defun fold-end-mode-quickly ()
  "Cleans up when the major mode is being changed.
This might be called when `kill-all-local-variables' is called.
It depends on what packages you have installed; GNU Emacs prior to
version 19.29 will not know to call this function."
  (and (boundp 'folding-mode)
       (assq 'folding-mode
	     (buffer-local-variables))
       folding-mode
       (progn
	 (widen)
	 (fold-clear-stack)
	 (fold-change-visibility (list 1 (point-max)) t))))

;;}}}

;;{{{ Conditional compilation again

;;{{{ Compiler bug workaround

;;;;;;; The FSF 2.10 compiler (with Emacs 19.19) generates the wrong code
;;;;;;; unless this is here.  It gets confused about the function name in our
;;;;;;; top-level defun.

;;;;;(defun fold-big-defun ())

;;}}}
;;{{{ Final fragment of fold-big-defun

;;;;;;; --> See "Initial fragment of fold-big-defun".
;;;;;;; Otherwise it won't be clear why there the indentation looks weird,
;;;;;;; and why the first part of the definition isn't used here.
;;;;;;; (It serves as a reminder, and is also used to fool indentation).

;;;;;;; Change ... " to ... \" to make the indentation behave temporarily,
;;;;;;; but remember to change it back before evalling or compiling.

;;;;;;; This code performs some simple substitutions on the code in the main
;;;;;;; part of the file, at compile time.

;;;;;"
;;;;;(defun fold-big-defun ()
;;;;;  (fold-pre-eval
;;;;;   (let ((bodies '(() ...body... "))
;;;;;	 output form type body)

;;;;;     ;; The rest of this code munges all the definitions in the main code.

;;;;;     ;; Starts with the list of forms `bodies'.
;;;;;     ;; Builds a new list of forms `output'.
;;;;;     ;; Macros are expanded (with a dynamic macro environment).
;;;;;     ;; After macro expansion, the following top-level forms are processed:
;;;;;     ;; Each `defun' is replaced by an `fset' equivalent.
;;;;;     ;; Each `defvar' and `defconst' is replaced by an equivalent expression.
;;;;;     ;; Each `defmacro-compile-only' form is evaluated but not included in the
;;;;;     ;; output (to save space in the byte-compiled output).
;;;;;     ;; Each `defmacro' form is evaluated and also an `fset' equivalent is
;;;;;     ;; produced for it.
;;;;;     ;; These substitutions are not performed recursively.
;;;;;     ;; A macro-environment for macroexpand is not enough, because that
;;;;;     ;; information still doesn't filter through to the v18 byte-compiler.

;;;;;     ;; The replaced code allows macros to be expanded at top-level
;;;;;     ;; outside defuns and defvars with the v18 compiler.  Furthermore,
;;;;;     ;; this stuff can be removed without changing much else if we
;;;;;     ;; decide to stop supporting v18.

;;;;;     ;; If Jamie Zawinski's compiler (which comes with Lucid and FSF Emacs
;;;;;     ;; 19, and is used by some other people too) is in use, we don't change
;;;;;     ;; the form of `defun', `defvar', `defconst' and `defmacro'.  That's
;;;;;     ;; because changing them causes the compiler to produce lots of warnings
;;;;;     ;; about fiddling with free variables and undefined functions.

;;;;;     (while bodies
;;;;;       (setq form (macroexpand (car bodies))
;;;;;	     bodies (cdr bodies))
;;;;;       (cond ((not (consp form)))
;;;;;	     ;; Flatten `progn' forms.
;;;;;	     ((eq 'progn (setq name (nth 1 form)
;;;;;			       type (car form)))
;;;;;	      (setq bodies (append (cdr form) bodies)))
;;;;;	     ((eq 'defmacro-compile-only type)
;;;;;	      (eval (cons 'defmacro (cdr form))))
;;;;;	     ;; This is how we detect jwz's compiler.
;;;;;	     ((boundp 'byte-compile-variables)
;;;;;	      (and (eq 'defmacro type)
;;;;;		   (eval form))
;;;;;	      (setq output (cons form output)))
;;;;;	     ;; Otherwise not jwz's compiler.
;;;;;	     ((memq type '(defvar defconst))
;;;;;	      (setq form (if (nth 3 form) ; Doc string?
;;;;;			     (list 'progn (list 'setq name (nth 2 form))
;;;;;				   (list 'put (list 'quote name)
;;;;;					 (list 'quote 'variable-documentation)
;;;;;					 (nth 3 form)))
;;;;;			   (list 'setq name (nth 2 form))))
;;;;;	      (and (eq 'defvar type)
;;;;;		   (setq form (list 'or
;;;;;				    (list 'boundp
;;;;;					  (list 'quote name)) form)))
;;;;;	      (setq output (cons form output)))
;;;;;	     ((memq type '(defun defmacro))
;;;;;	      (let ((temp (list 'function (cons 'lambda (cdr (cdr form))))))
;;;;;		(and (eq type 'defmacro)
;;;;;		     (setq temp (list 'cons (list 'quote 'macro) temp))
;;;;;		     (eval form))
;;;;;		(setq output (cons (list 'fset (list 'quote name) temp)
;;;;;				   output))))
;;;;;	     ;; Now it is just a normal cons cell.
;;;;;	     (t
;;;;;	      (setq output (cons form output)))
;;;;;	     ;; If form is not a cons, it should be discarded.
;;;;;	     ))
;;;;;     (append '(progn) (nreverse output)
;;;;;	     '((fmakunbound 'fold-big-defun)
;;;;;	       (fmakunbound 'fold-pre-eval))))))

;;;;;(fold-big-defun)

;;}}}

;;}}}
;;{{{ Declare `folding' as a feature, run `folding-load-hook'

(provide 'folding)
(run-hooks 'folding-load-hook)

;;}}}

;;; folding.el ends here