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