--- /dev/null
+;;; tex-fold.el --- Fold TeX macros.
+
+;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+
+;; Author: Ralf Angeli <angeli@caeruleus.net>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2004-07-04
+;; Keywords: tex, wp
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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 3, or (at your option)
+;; any later version.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file provides support for hiding and unhiding TeX, LaTeX,
+;; ContTeXt, Texinfo and similar macros and environments inside of
+;; AUCTeX.
+;;
+;; Caveats:
+;;
+;; The display string of content which should display part of itself
+;; is made by copying the text from the buffer together with its text
+;; properties. If fontification has not happened when this is done
+;; (e.g. because of lazy or just-in-time font locking) the intended
+;; fontification will not show up. Maybe this could be improved by
+;; using some sort of "lazy folding" or refreshing the window upon
+;; scrolling. As a workaround fontification of the whole buffer
+;; currently is forced before folding it.
+
+;;; Code:
+
+(when (featurep 'xemacs)
+ (require 'overlay))
+(require 'tex)
+(autoload 'LaTeX-forward-paragraph "latex")
+(autoload 'LaTeX-backward-paragraph "latex")
+(autoload 'LaTeX-find-matching-begin "latex")
+(autoload 'LaTeX-find-matching-end "latex")
+(autoload 'ConTeXt-find-matching-start "context")
+(autoload 'ConTeXt-find-matching-stop "context")
+(autoload 'Texinfo-find-env-start "tex-info")
+(autoload 'Texinfo-find-env-end "tex-info")
+
+(defgroup TeX-fold nil
+ "Fold TeX macros."
+ :group 'AUCTeX)
+
+(defcustom TeX-fold-type-list '(env macro math)
+ "List of item types to consider when folding.
+Valid items are the symbols 'env for environments, 'macro for
+macros, 'math for math macros and 'comment for comments."
+ :type '(set (const :tag "Environments" env)
+ (const :tag "Macros" macro)
+ (const :tag "Math Macros" math)
+ (const :tag "Comments" comment))
+ :group 'TeX-fold)
+
+(defcustom TeX-fold-macro-spec-list
+ `(("[f]" ("footnote" "marginpar"))
+ ("[c]" ("cite"))
+ ("[l]" ("label"))
+ ("[r]" ("ref" "pageref" "eqref"))
+ ("[i]" ("index" "glossary"))
+ ("[1]:||*" ("item"))
+ ("..." ("dots"))
+ ("(C)" ("copyright"))
+ ("(R)" ("textregistered"))
+ ("TM" ("texttrademark"))
+ (1 ("part" "chapter" "section" "subsection" "subsubsection"
+ "paragraph" "subparagraph"
+ "part*" "chapter*" "section*" "subsection*" "subsubsection*"
+ "paragraph*" "subparagraph*"
+ "emph" "textit" "textsl" "textmd" "textrm" "textsf" "texttt"
+ "textbf" "textsc" "textup")))
+ "List of replacement specifiers and macros to fold.
+
+The first element of each item can be a string, an integer or a
+function symbol. The second element is a list of macros two fold
+without the leading backslash.
+
+If the first element is a string, it will be used as a display
+replacement for the whole macro. Numbers in braces, brackets,
+parens or angle brackets will be replaced by the respective macro
+argument. For example \"{1}\" will be replaced by the first
+mandatory argument of the macro. One can also define
+alternatives within the specifier which are used if an argument
+is not found. Alternatives are separated by \"||\". They are
+most useful with optional arguments. As an example, the default
+specifier for \\item is \"[1]:||*\" which means that if there is
+an optional argument, its value is shown followed by a colon. If
+there is no optional argument, only an asterisk is used as the
+display string.
+
+If the first element is an integer, the macro will be replaced by
+the respective macro argument.
+
+If the first element is a function symbol, the function will be
+called with all mandatory arguments of the macro and the result
+of the function call will be used as a replacement for the macro.
+
+Setting this variable does not take effect immediately. Use
+Customize or reset the mode."
+ :type '(repeat (group (choice (string :tag "Display String")
+ (integer :tag "Number of argument" :value 1)
+ (function :tag "Function to execute"))
+ (repeat :tag "Macros" (string))))
+ :group 'TeX-fold)
+
+(defvar TeX-fold-macro-spec-list-internal nil
+ "Internal list of display strings and macros to fold.
+Is updated when the TeX Fold mode is being activated and then
+contains all constructs to fold for the given buffer or mode
+respectively, i.e. contents of both `TeX-fold-macro-spec-list'
+and <mode-prefix>-fold-macro-spec-list.")
+(make-variable-buffer-local 'TeX-fold-macro-spec-list-internal)
+
+(defcustom TeX-fold-env-spec-list
+ '(("[comment]" ("comment")))
+ "List of display strings and environments to fold."
+ :type '(repeat (group (choice (string :tag "Display String")
+ (integer :tag "Number of argument" :value 1))
+ (repeat :tag "Environments" (string))))
+ :group 'TeX-fold)
+
+(defvar TeX-fold-env-spec-list-internal nil
+ "Internal list of display strings and environments to fold.
+Is updated when the TeX Fold mode is being activated and then
+contains all constructs to fold for the given buffer or mode
+respectively, i.e. contents of both `TeX-fold-env-spec-list'
+and <mode-prefix>-fold-env-spec-list.")
+(make-variable-buffer-local 'TeX-fold-env-spec-list-internal)
+
+(defcustom TeX-fold-math-spec-list nil
+ "List of display strings and math macros to fold."
+ :type '(repeat (group (choice (string :tag "Display String")
+ (integer :tag "Number of argument" :value 1))
+ (repeat :tag "Math Macros" (string))))
+ :group 'TeX-fold)
+
+(defvar TeX-fold-math-spec-list-internal nil
+ "Internal list of display strings and math macros to fold.
+Is updated when the TeX Fold mode is being activated and then
+contains all constructs to fold for the given buffer or mode
+respectively, i.e. contents of both `TeX-fold-math-spec-list'
+and <mode-prefix>-fold-math-spec-list.")
+(make-variable-buffer-local 'TeX-fold-math-spec-list-internal)
+
+(defcustom TeX-fold-unspec-macro-display-string "[m]"
+ "Display string for unspecified macros.
+This string will be displayed if a single macro is being hidden
+which is not specified in `TeX-fold-macro-spec-list'."
+ :type '(string)
+ :group 'TeX-fold)
+
+(defcustom TeX-fold-unspec-env-display-string "[env]"
+ "Display string for unspecified environments.
+This string will be displayed if a single environment is being
+hidden which is not specified in `TeX-fold-env-spec-list'."
+ :type '(string)
+ :group 'TeX-fold)
+
+(defcustom TeX-fold-unspec-use-name t
+ "If non-nil use the name of an unspecified item as display string.
+Set it to nil if you want to use the values of the variables
+`TeX-fold-unspec-macro-display-string' or
+`TeX-fold-unspec-env-display-string' respectively as a display
+string for any unspecified macro or environment."
+ :type 'boolean
+ :group 'TeX-fold)
+
+(defcustom TeX-fold-preserve-comments nil
+ "If non-nil do not fold in comments."
+ :type 'boolean
+ :group 'TeX-fold)
+
+(defcustom TeX-fold-unfold-around-mark t
+ "Unfold text around the mark, if active."
+ :type 'boolean
+ :group 'TeX-fold)
+
+(defcustom TeX-fold-help-echo-max-length 70
+ "Maximum length of help echo message for folded overlays.
+Set it to zero in order to disable help echos."
+ :type 'integer
+ :group 'TeX-fold)
+
+(defcustom TeX-fold-force-fontify t
+ "Force the buffer to be fully fontified by folding it."
+ :group 'TeX-fold
+ :type 'boolean)
+
+(defcustom TeX-fold-auto nil
+ "If non-nil, fold macros automatically after `TeX-insert-macro'."
+ :group 'TeX-fold
+ :type 'boolean)
+
+(defface TeX-fold-folded-face
+ '((((class color) (background light))
+ (:foreground "SlateBlue"))
+ (((class color) (background dark))
+ (:foreground "SlateBlue1"))
+ (((class grayscale) (background light))
+ (:foreground "DimGray"))
+ (((class grayscale) (background dark))
+ (:foreground "LightGray"))
+ (t (:slant italic)))
+ "Face for the display string of folded content."
+ :group 'TeX-fold)
+
+(defvar TeX-fold-folded-face 'TeX-fold-folded-face
+ "Face for the display string of folded content.")
+
+(defface TeX-fold-unfolded-face
+ '((((class color) (background light))
+ (:background "#f2f0fd"))
+ (((class color) (background dark))
+ (:background "#38405d"))
+ (((class grayscale) (background light))
+ (:background "LightGray"))
+ (((class grayscale) (background dark))
+ (:background "DimGray"))
+ (t (:inverse-video t)))
+ "Face for folded content when it is temporarily opened."
+ :group 'TeX-fold)
+
+(defvar TeX-fold-unfolded-face 'TeX-fold-unfolded-face
+ "Face for folded content when it is temporarily opened.")
+
+(defvar TeX-fold-ellipsis "..."
+ "String used as display string for overlays instead of a zero-length string.")
+
+(defvar TeX-fold-open-spots nil)
+(make-variable-buffer-local 'TeX-fold-open-spots)
+
+(defcustom TeX-fold-command-prefix "\C-c\C-o"
+ "Prefix key to use for commands in TeX Fold mode.
+The value of this variable is checked as part of loading TeX Fold mode.
+After that, changing the prefix key requires manipulating keymaps."
+ :type 'string
+ :group 'TeX-fold)
+
+(defvar TeX-fold-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-o" 'TeX-fold-dwim)
+ (define-key map "\C-b" 'TeX-fold-buffer)
+ (define-key map "\C-r" 'TeX-fold-region)
+ (define-key map "\C-p" 'TeX-fold-paragraph)
+ (define-key map "\C-m" 'TeX-fold-macro)
+ (define-key map "\C-e" 'TeX-fold-env)
+ (define-key map "\C-c" 'TeX-fold-comment)
+ (define-key map "b" 'TeX-fold-clearout-buffer)
+ (define-key map "r" 'TeX-fold-clearout-region)
+ (define-key map "p" 'TeX-fold-clearout-paragraph)
+ (define-key map "i" 'TeX-fold-clearout-item)
+ map))
+
+
+;;; Folding
+
+(defun TeX-fold-dwim ()
+ "Hide or show items according to the current context.
+If there is folded content, unfold it. If there is a marked
+region, fold all configured content in this region. If there is
+no folded content but a macro or environment, fold it."
+ (interactive)
+ (cond ((TeX-fold-clearout-item))
+ ((TeX-active-mark) (TeX-fold-region (mark) (point)))
+ ((TeX-fold-item 'macro))
+ ((TeX-fold-item 'math))
+ ((TeX-fold-item 'env))
+ ((TeX-fold-comment))))
+
+(defun TeX-fold-buffer ()
+ "Hide all configured macros and environments in the current buffer.
+The relevant macros are specified in the variable `TeX-fold-macro-spec-list'
+and `TeX-fold-math-spec-list', and environments in `TeX-fold-env-spec-list'."
+ (interactive)
+ (TeX-fold-clearout-region (point-min) (point-max))
+ (when (and TeX-fold-force-fontify
+ (boundp 'jit-lock-mode)
+ jit-lock-mode
+ (fboundp 'jit-lock-fontify-now))
+ ;; We force fontification here only because it should rarely be
+ ;; needed for the other folding commands.
+ (jit-lock-fontify-now))
+ (TeX-fold-region (point-min) (point-max)))
+
+(defun TeX-fold-paragraph ()
+ "Hide all configured macros and environments in the current paragraph.
+The relevant macros are specified in the variable `TeX-fold-macro-spec-list'
+and `TeX-fold-math-spec-list', and environments in `TeX-fold-env-spec-list'."
+ (interactive)
+ (save-excursion
+ (let ((end (progn (LaTeX-forward-paragraph) (point)))
+ (start (progn (LaTeX-backward-paragraph) (point))))
+ (TeX-fold-clearout-region start end)
+ (TeX-fold-region start end))))
+
+(defun TeX-fold-region (start end)
+ "Fold all items in region from START to END."
+ (interactive "r")
+ (when (and (memq 'env TeX-fold-type-list)
+ (not (eq major-mode 'plain-tex-mode)))
+ (TeX-fold-region-macro-or-env start end 'env))
+ (when (memq 'macro TeX-fold-type-list)
+ (TeX-fold-region-macro-or-env start end 'macro))
+ (when (memq 'math TeX-fold-type-list)
+ (TeX-fold-region-macro-or-env start end 'math))
+ (when (memq 'comment TeX-fold-type-list)
+ (TeX-fold-region-comment start end)))
+
+(defun TeX-fold-region-macro-or-env (start end type)
+ "Fold all items of type TYPE in region from START to END.
+TYPE can be one of the symbols 'env for environments, 'macro
+for macros and 'math for math macros."
+ (save-excursion
+ (let (fold-list item-list regexp)
+ (dolist (item (cond ((eq type 'env) TeX-fold-env-spec-list-internal)
+ ((eq type 'math) TeX-fold-math-spec-list-internal)
+ (t TeX-fold-macro-spec-list-internal)))
+ (dolist (i (cadr item))
+ (add-to-list 'fold-list (list i (car item)))
+ (add-to-list 'item-list i)))
+ (when item-list
+ (setq regexp (cond ((and (eq type 'env)
+ (eq major-mode 'context-mode))
+ (concat (regexp-quote TeX-esc)
+ "start" (regexp-opt item-list t)))
+ ((and (eq type 'env)
+ (eq major-mode 'texinfo-mode))
+ (concat (regexp-quote TeX-esc)
+ (regexp-opt item-list t)))
+ ((eq type 'env)
+ (concat (regexp-quote TeX-esc)
+ "begin[ \t]*{"
+ (regexp-opt item-list t) "}"))
+ (t
+ (concat (regexp-quote TeX-esc)
+ (regexp-opt item-list t)))))
+ (save-restriction
+ (narrow-to-region start end)
+ ;; Start from the bottom so that it is easier to prioritize
+ ;; nested macros.
+ (goto-char (point-max))
+ (let ((case-fold-search nil)
+ item-name)
+ (while (re-search-backward regexp nil t)
+ (setq item-name (match-string 1))
+ (unless (or (and TeX-fold-preserve-comments
+ (TeX-in-commented-line))
+ ;; Make sure no partially matched macros are
+ ;; folded. For macros consisting of letters
+ ;; this means there should be none of the
+ ;; characters [A-Za-z@*] after the matched
+ ;; string. Single-char non-letter macros like
+ ;; \, don't have this requirement.
+ (and (memq type '(macro math))
+ (save-match-data
+ (string-match "[A-Za-z]" item-name))
+ (save-match-data
+ (string-match "[A-Za-z@*]"
+ (string (char-after
+ (match-end 0)))))))
+ (let* ((item-start (match-beginning 0))
+ (display-string-spec (cadr (assoc item-name
+ fold-list)))
+ (item-end (TeX-fold-item-end item-start type))
+ (ov (TeX-fold-make-overlay item-start item-end type
+ display-string-spec)))
+ (TeX-fold-hide-item ov))))))))))
+
+(defun TeX-fold-region-comment (start end)
+ "Fold all comments in region from START to END."
+ (save-excursion
+ (goto-char start)
+ (let (beg)
+ (while (setq beg (TeX-search-forward-comment-start end))
+ (goto-char beg)
+ ;; Determine the start of the region to be folded just behind
+ ;; the comment starter.
+ (looking-at TeX-comment-start-regexp)
+ (setq beg (match-end 0))
+ ;; Search for the end of the comment.
+ (while (TeX-comment-forward))
+ (end-of-line 0)
+ ;; Hide the whole region.
+ (TeX-fold-hide-item (TeX-fold-make-overlay beg (point) 'comment
+ TeX-fold-ellipsis))))))
+
+(defun TeX-fold-macro ()
+ "Hide the macro on which point currently is located."
+ (interactive)
+ (unless (TeX-fold-item 'macro)
+ (message "No macro found")))
+
+(defun TeX-fold-math ()
+ "Hide the math macro on which point currently is located."
+ (interactive)
+ (unless (TeX-fold-item 'math)
+ (message "No macro found")))
+
+(defun TeX-fold-env ()
+ "Hide the environment on which point currently is located."
+ (interactive)
+ (unless (TeX-fold-item 'env)
+ (message "No environment found")))
+
+(defun TeX-fold-comment ()
+ "Hide the comment on which point currently is located."
+ (interactive)
+ (unless (TeX-fold-comment-do)
+ (message "No comment found")))
+
+(defun TeX-fold-item (type)
+ "Hide the item on which point currently is located.
+TYPE specifies the type of item and can be one of the symbols
+'env for environments, 'macro for macros or 'math for math
+macros.
+Return non-nil if an item was found and folded, nil otherwise."
+ (if (and (eq type 'env)
+ (eq major-mode 'plain-tex-mode))
+ (message
+ "Folding of environments is not supported in current mode")
+ (let ((item-start (cond ((and (eq type 'env)
+ (eq major-mode 'context-mode))
+ (save-excursion
+ (ConTeXt-find-matching-start) (point)))
+ ((and (eq type 'env)
+ (eq major-mode 'texinfo-mode))
+ (save-excursion
+ (Texinfo-find-env-start) (point)))
+ ((eq type 'env)
+ (condition-case nil
+ (save-excursion
+ (LaTeX-find-matching-begin) (point))
+ (error nil)))
+ (t
+ (TeX-find-macro-start)))))
+ (when item-start
+ (let* ((item-name (save-excursion
+ (goto-char item-start)
+ (looking-at
+ (cond ((and (eq type 'env)
+ (eq major-mode 'context-mode))
+ (concat (regexp-quote TeX-esc)
+ "start\\([A-Za-z]+\\)"))
+ ((and (eq type 'env)
+ (eq major-mode 'texinfo-mode))
+ (concat (regexp-quote TeX-esc)
+ "\\([A-Za-z]+\\)"))
+ ((eq type 'env)
+ (concat (regexp-quote TeX-esc)
+ "begin[ \t]*{"
+ "\\([A-Za-z]+\\)}"))
+ (t
+ (concat (regexp-quote TeX-esc)
+ "\\([A-Za-z@*]+\\)"))))
+ (if (fboundp 'match-string-no-properties)
+ (match-string-no-properties 1)
+ (match-string 1))))
+ (fold-list (cond ((eq type 'env) TeX-fold-env-spec-list-internal)
+ ((eq type 'math)
+ TeX-fold-math-spec-list-internal)
+ (t TeX-fold-macro-spec-list-internal)))
+ fold-item
+ (display-string-spec
+ (or (catch 'found
+ (while fold-list
+ (setq fold-item (car fold-list))
+ (setq fold-list (cdr fold-list))
+ (when (member item-name (cadr fold-item))
+ (throw 'found (car fold-item)))))
+ ;; Item is not specified.
+ (if TeX-fold-unspec-use-name
+ (concat "[" item-name "]")
+ (if (eq type 'env)
+ TeX-fold-unspec-env-display-string
+ TeX-fold-unspec-macro-display-string))))
+ (item-end (TeX-fold-item-end item-start type))
+ (ov (TeX-fold-make-overlay item-start item-end type
+ display-string-spec)))
+ (TeX-fold-hide-item ov))))))
+
+(defun TeX-fold-comment-do ()
+ "Hide the comment on which point currently is located.
+This is the function doing the work for `TeX-fold-comment'. It
+is an internal function communicating with return values rather
+than with messages for the user.
+Return non-nil if a comment was found and folded, nil otherwise."
+ (if (and (not (TeX-in-comment)) (not (TeX-in-line-comment)))
+ nil
+ (let (beg)
+ (save-excursion
+ (while (progn
+ (beginning-of-line 0)
+ (and (TeX-in-line-comment)
+ (not (bobp)))))
+ (goto-char (TeX-search-forward-comment-start (line-end-position 2)))
+ (looking-at TeX-comment-start-regexp)
+ (setq beg (match-end 0))
+ (while (TeX-comment-forward))
+ (end-of-line 0)
+ (when (> (point) beg)
+ (TeX-fold-hide-item (TeX-fold-make-overlay beg (point) 'comment
+ TeX-fold-ellipsis)))))))
+
+
+;;; Utilities
+
+(defun TeX-fold-make-overlay (ov-start ov-end type display-string-spec)
+ "Make a TeX-fold overlay extending from OV-START to OV-END.
+TYPE is a symbol which is used to describe the content to hide
+and may be 'macro for macros, 'math for math macro and 'env for
+environments.
+DISPLAY-STRING-SPEC is the original specification of the display
+string in the variables `TeX-fold-macro-spec-list' or
+`TeX-fold-env-spec-list' and may be a string or an integer."
+ ;; Calculate priority before the overlay is instantiated. We don't
+ ;; want `TeX-overlay-prioritize' to pick up a non-prioritized one.
+ (let ((priority (TeX-overlay-prioritize ov-start ov-end))
+ (ov (make-overlay ov-start ov-end (current-buffer) t nil)))
+ (overlay-put ov 'category 'TeX-fold)
+ (overlay-put ov 'priority priority)
+ (overlay-put ov 'evaporate t)
+ (overlay-put ov 'TeX-fold-type type)
+ (overlay-put ov 'TeX-fold-display-string-spec display-string-spec)
+ ov))
+
+(defun TeX-fold-item-end (start type)
+ "Return the end of an item of type TYPE starting at START.
+TYPE can be either 'env for environments, 'macro for macros or
+'math for math macros."
+ (save-excursion
+ (cond ((and (eq type 'env)
+ (eq major-mode 'context-mode))
+ (goto-char start)
+ (ConTeXt-find-matching-stop)
+ (point))
+ ((and (eq type 'env)
+ (eq major-mode 'texinfo-mode))
+ (goto-char (1+ start))
+ (Texinfo-find-env-end)
+ (point))
+ ((eq type 'env)
+ (goto-char (1+ start))
+ (LaTeX-find-matching-end)
+ (point))
+ (t
+ (goto-char start)
+ (TeX-find-macro-end)))))
+
+(defun TeX-fold-overfull-p (ov-start ov-end display-string)
+ "Return t if an overfull line will result after adding an overlay.
+The overlay extends from OV-START to OV-END and will display the
+string DISPLAY-STRING."
+ (and (not (featurep 'xemacs)) ; Linebreaks in glyphs don't
+ ; work in XEmacs anyway.
+ (save-excursion
+ (goto-char ov-end)
+ (search-backward "\n" ov-start t))
+ (not (string-match "\n" display-string))
+ (> (+ (- ov-start
+ (save-excursion
+ (goto-char ov-start)
+ (line-beginning-position)))
+ (length display-string)
+ (- (save-excursion
+ (goto-char ov-end)
+ (line-end-position))
+ ov-end))
+ (current-fill-column))))
+
+(defun TeX-fold-macro-nth-arg (n macro-start &optional macro-end delims)
+ "Return a property list of the argument number N of a macro.
+The start of the macro to examine is given by MACRO-START, its
+end optionally by MACRO-END. With DELIMS the type of delimiters
+can be specified as a cons cell containing the opening char as
+the car and the closing char as the cdr. The chars have to have
+opening and closing syntax as defined in
+`TeX-search-syntax-table'.
+
+The first item in the returned list is the string specified in
+the argument, the second item may be a face if the argument
+string was fontified. In Emacs the string holds text properties
+as well, so the second item is always nil. In XEmacs the string
+does not enclose any faces, so these are given in the second item
+of the resulting list."
+ (save-excursion
+ (let* ((macro-end (or macro-end
+ (save-excursion (goto-char macro-start)
+ (TeX-find-macro-end))))
+ (open-char (if delims (car delims) ?{))
+ (open-string (char-to-string open-char))
+ (close-char (if delims (cdr delims) ?}))
+ (close-string (char-to-string close-char))
+ content-start content-end)
+ (goto-char macro-start)
+ (if (condition-case nil
+ (progn
+ (while (> n 0)
+ (skip-chars-forward (concat "^" open-string) macro-end)
+ (when (= (point) macro-end)
+ (error nil))
+ (setq content-start (progn
+ (skip-chars-forward
+ (concat open-string " \t"))
+ (point)))
+ (goto-char
+ (if delims
+ (with-syntax-table
+ (TeX-search-syntax-table open-char close-char)
+ (scan-lists (point) 1 1))
+ (TeX-find-closing-brace)))
+ (setq content-end (save-excursion
+ (backward-char)
+ (skip-chars-backward " \t")
+ (point)))
+ (setq n (1- n)))
+ t)
+ (error nil))
+ (list (TeX-fold-buffer-substring content-start content-end)
+ (when (and (featurep 'xemacs)
+ (extent-at content-start))
+ ;; A glyph in XEmacs does not seem to be able to hold more
+ ;; than one face, so we just use the first one we get.
+ (car (extent-property (extent-at content-start) 'face))))
+ nil))))
+
+(defun TeX-fold-buffer-substring (start end)
+ "Return the contents of buffer from START to END as a string.
+Like `buffer-substring' but copy overlay display strings as well."
+ ;; Swap values of `start' and `end' if necessary.
+ (when (> start end) (let ((tmp start)) (setq start end end tmp)))
+ (let ((overlays (overlays-in start end))
+ result)
+ ;; Get rid of overlays not under our control or not completely
+ ;; inside the specified region.
+ (dolist (ov overlays)
+ (when (or (not (eq (overlay-get ov 'category) 'TeX-fold))
+ (< (overlay-start ov) start)
+ (> (overlay-end ov) end))
+ (setq overlays (remove ov overlays))))
+ (if (null overlays)
+ (buffer-substring start end)
+ ;; Sort list according to ascending starts.
+ (setq overlays (sort (copy-sequence overlays)
+ (lambda (a b)
+ (< (overlay-start a) (overlay-start b)))))
+ ;; Get the string from the start of the region up to the first overlay.
+ (setq result (buffer-substring start (overlay-start (car overlays))))
+ (let (ov)
+ (while overlays
+ (setq ov (car overlays)
+ overlays (cdr overlays))
+ ;; Add the display string of the overlay.
+ (setq result (concat result (overlay-get ov 'display)))
+ ;; Remove overlays contained in the current one.
+ (dolist (elt overlays)
+ (when (< (overlay-start elt) (overlay-end ov))
+ (setq overlays (remove elt overlays))))
+ ;; Add the string from the end of the current overlay up to
+ ;; the next overlay or the end of the specified region.
+ (setq result (concat result (buffer-substring (overlay-end ov)
+ (if overlays
+ (overlay-start
+ (car overlays))
+ end))))))
+ result)))
+
+(defun TeX-fold-make-help-echo (start end)
+ "Return a string to be used as the help echo of folded overlays.
+The text between START and END will be used for this but cropped
+to the length defined by `TeX-fold-help-echo-max-length'. Line
+breaks will be replaced by spaces."
+ (let* ((spill (+ start TeX-fold-help-echo-max-length))
+ (lines (split-string (buffer-substring start (min end spill)) "\n"))
+ (result (pop lines)))
+ (dolist (line lines)
+ ;; Strip leading whitespace
+ (when (string-match "^[ \t]+" line)
+ (setq line (replace-match "" nil nil line)))
+ ;; Strip trailing whitespace
+ (when (string-match "[ \t]+$" line)
+ (setq line (replace-match "" nil nil line)))
+ (setq result (concat result " " line)))
+ (when (> end spill) (setq result (concat result "...")))
+ result))
+
+(defun TeX-fold-update-at-point ()
+ "Update all TeX-fold overlays at point displaying computed content."
+ (let (overlays)
+ ;; Get all overlays at point under our control.
+ (dolist (ov (overlays-at (point)))
+ (when (and (eq (overlay-get ov 'category) 'TeX-fold)
+ (numberp (overlay-get ov 'TeX-fold-display-string-spec)))
+ (add-to-list 'overlays ov)))
+ (when overlays
+ ;; Sort list according to descending starts.
+ (setq overlays (sort (copy-sequence overlays)
+ (lambda (a b)
+ (> (overlay-start a) (overlay-start b)))))
+ (dolist (ov overlays)
+ (TeX-fold-hide-item ov)))))
+
+
+;;; Removal
+
+(defun TeX-fold-clearout-buffer ()
+ "Permanently show all macros in the buffer."
+ (interactive)
+ (TeX-fold-clearout-region (point-min) (point-max)))
+
+(defun TeX-fold-clearout-paragraph ()
+ "Permanently show all macros in the paragraph point is located in."
+ (interactive)
+ (save-excursion
+ (let ((end (progn (LaTeX-forward-paragraph) (point)))
+ (start (progn (LaTeX-backward-paragraph) (point))))
+ (TeX-fold-clearout-region start end))))
+
+(defun TeX-fold-clearout-region (start end)
+ "Permanently show all macros in region starting at START and ending at END."
+ (interactive "r")
+ (let ((overlays (overlays-in start end)))
+ (TeX-fold-remove-overlays overlays)))
+
+(defun TeX-fold-clearout-item ()
+ "Permanently show the macro on which point currently is located."
+ (interactive)
+ (let ((overlays (overlays-at (point))))
+ (TeX-fold-remove-overlays overlays)))
+
+(defun TeX-fold-remove-overlays (overlays)
+ "Remove all overlays set by TeX-fold in OVERLAYS.
+Return non-nil if a removal happened, nil otherwise."
+ (let (found)
+ (while overlays
+ (when (eq (overlay-get (car overlays) 'category) 'TeX-fold)
+ (delete-overlay (car overlays))
+ (setq found t))
+ (setq overlays (cdr overlays)))
+ found))
+
+
+;;; Toggling
+
+(defun TeX-fold-expand-spec (spec ov-start ov-end)
+ "Expand instances of {<num>}, [<num>], <<num>>, and (<num>).
+Replace them with the respective macro argument."
+ (let ((spec-list (split-string spec "||"))
+ (delims '((?{ . ?}) (?[ . ?]) (?< . ?>) (?\( . ?\))))
+ match-end success)
+ (catch 'success
+ ;; Iterate over alternatives.
+ (dolist (elt spec-list)
+ (setq spec elt)
+ ;; Find and expand every placeholder.
+ (while (and (string-match "\\([[{<]\\)\\([1-9]\\)\\([]}>]\\)" elt
+ match-end)
+ ;; Does the closing delim fit to the opening one?
+ (string-equal
+ (match-string 3 elt)
+ (char-to-string
+ (cdr (assq (string-to-char (match-string 1 elt))
+ delims)))))
+ (setq match-end (match-beginning 0))
+ (let ((arg (car (save-match-data
+ ;; Get the argument.
+ (TeX-fold-macro-nth-arg
+ (string-to-number (match-string 2 elt))
+ ov-start ov-end
+ (assoc (string-to-char (match-string 1 elt))
+ delims))))))
+ (when arg (setq success t))
+ ;; Replace the placeholder in the string.
+ (setq elt (replace-match (or arg TeX-fold-ellipsis) nil t elt)
+ spec elt)))
+ (when success (throw 'success nil))))
+ spec))
+
+(defun TeX-fold-hide-item (ov)
+ "Hide a single macro or environment.
+That means, put respective properties onto overlay OV."
+ (let* ((ov-start (overlay-start ov))
+ (ov-end (overlay-end ov))
+ (spec (overlay-get ov 'TeX-fold-display-string-spec))
+ (computed (cond
+ ((stringp spec)
+ (TeX-fold-expand-spec spec ov-start ov-end))
+ ((functionp spec)
+ (let (arg arg-list
+ (n 1))
+ (while (setq arg (TeX-fold-macro-nth-arg
+ n ov-start ov-end))
+ (add-to-list 'arg-list (car arg) t)
+ (setq n (1+ n)))
+ (or (condition-case nil
+ (apply spec arg-list)
+ (error nil))
+ "[Error: No content or function found]")))
+ (t (or (TeX-fold-macro-nth-arg spec ov-start ov-end)
+ "[Error: No content found]"))))
+ (display-string (if (listp computed) (car computed) computed))
+ (face (when (listp computed) (cadr computed))))
+ ;; Cater for zero-length display strings.
+ (when (string= display-string "") (setq display-string TeX-fold-ellipsis))
+ ;; Add a linebreak to the display string and adjust the overlay end
+ ;; in case of an overfull line.
+ (when (TeX-fold-overfull-p ov-start ov-end display-string)
+ (setq display-string (concat display-string "\n"))
+ (move-overlay ov ov-start (save-excursion
+ (goto-char ov-end)
+ (skip-chars-forward " \t")
+ (point))))
+ (overlay-put ov 'mouse-face 'highlight)
+ (overlay-put ov 'display display-string)
+ (if (featurep 'xemacs)
+ (let ((glyph (make-glyph (if (listp display-string)
+ (car display-string)
+ display-string))))
+ (overlay-put ov 'invisible t)
+ (when font-lock-mode
+ (if face
+ (set-glyph-property glyph 'face face)
+ (set-glyph-property glyph 'face TeX-fold-folded-face)))
+ (set-extent-property ov 'end-glyph glyph))
+ (when font-lock-mode
+ (overlay-put ov 'face TeX-fold-folded-face))
+ (unless (zerop TeX-fold-help-echo-max-length)
+ (overlay-put ov 'help-echo (TeX-fold-make-help-echo
+ (overlay-start ov) (overlay-end ov)))))))
+
+(defun TeX-fold-show-item (ov)
+ "Show a single LaTeX macro or environment.
+Remove the respective properties from the overlay OV."
+ (overlay-put ov 'mouse-face nil)
+ (if (featurep 'xemacs)
+ (progn
+ (set-extent-property ov 'end-glyph nil)
+ (overlay-put ov 'invisible nil))
+ (overlay-put ov 'display nil)
+ (overlay-put ov 'help-echo nil)
+ (when font-lock-mode
+ (overlay-put ov 'face TeX-fold-unfolded-face))))
+
+;; Copy and adaption of `reveal-post-command' from reveal.el in GNU
+;; Emacs on 2004-07-04.
+(defun TeX-fold-post-command ()
+ ;; `with-local-quit' is not supported in XEmacs.
+ (condition-case nil
+ (let ((inhibit-quit nil))
+ (condition-case err
+ (let* ((spots (TeX-fold-partition-list
+ (lambda (x)
+ ;; We refresh any spot in the current
+ ;; window as well as any spots associated
+ ;; with a dead window or a window which
+ ;; does not show this buffer any more.
+ (or (eq (car x) (selected-window))
+ (not (window-live-p (car x)))
+ (not (eq (window-buffer (car x))
+ (current-buffer)))))
+ TeX-fold-open-spots))
+ (old-ols (mapcar 'cdr (car spots))))
+ (setq TeX-fold-open-spots (cdr spots))
+ (when (or (and (boundp 'disable-point-adjustment)
+ disable-point-adjustment)
+ (and (boundp 'global-disable-point-adjustment)
+ global-disable-point-adjustment)
+ ;; See preview.el on how to make this configurable.
+ (memq this-command (list (key-binding [left])
+ (key-binding [right])
+ 'mouse-set-point)))
+ ;; Open new overlays.
+ (dolist (ol (nconc (when (and TeX-fold-unfold-around-mark
+ (boundp 'mark-active)
+ mark-active)
+ (overlays-at (mark)))
+ (overlays-at (point))))
+ (when (eq (overlay-get ol 'category) 'TeX-fold)
+ (push (cons (selected-window) ol) TeX-fold-open-spots)
+ (setq old-ols (delq ol old-ols))
+ (TeX-fold-show-item ol))))
+ ;; Close old overlays.
+ (dolist (ol old-ols)
+ (when (and (eq (current-buffer) (overlay-buffer ol))
+ (not (rassq ol TeX-fold-open-spots))
+ (or (not (featurep 'xemacs))
+ (and (featurep 'xemacs)
+ (not (extent-detached-p ol)))))
+ (if (and (>= (point) (overlay-start ol))
+ (<= (point) (overlay-end ol)))
+ ;; Still near the overlay: keep it open.
+ (push (cons (selected-window) ol) TeX-fold-open-spots)
+ ;; Really close it.
+ (TeX-fold-hide-item ol)))))
+ (error (message "TeX-fold: %s" err))))
+ (quit (setq quit-flag t))))
+
+
+;;; Misc
+
+;; Copy and adaption of `cvs-partition' from pcvs-util.el in GNU Emacs
+;; on 2004-07-05 to make tex-fold.el mainly self-contained.
+(defun TeX-fold-partition-list (p l)
+ "Partition a list L into two lists based on predicate P.
+The function returns a `cons' cell where the `car' contains
+elements of L for which P is true while the `cdr' contains
+the other elements. The ordering among elements is maintained."
+ (let (car cdr)
+ (dolist (x l)
+ (if (funcall p x) (push x car) (push x cdr)))
+ (cons (nreverse car) (nreverse cdr))))
+
+
+;;; The mode
+
+;; This autoload cookie had to be changed because of XEmacs. This is
+;; very dissatisfactory, because we now don't have the full doc string
+;; available to tell people what to expect when using this mode before
+;; loading it.
+
+;;;###autoload (autoload 'TeX-fold-mode "tex-fold" "Minor mode for hiding and revealing macros and environments." t)
+(define-minor-mode TeX-fold-mode
+ "Minor mode for hiding and revealing macros and environments.
+
+Called interactively, with no prefix argument, toggle the mode.
+With universal prefix ARG (or if ARG is nil) turn mode on.
+With zero or negative ARG turn mode off."
+ nil nil (list (cons TeX-fold-command-prefix TeX-fold-keymap))
+ (if TeX-fold-mode
+ (progn
+ (set (make-local-variable 'search-invisible) t)
+ (add-hook 'post-command-hook 'TeX-fold-post-command nil t)
+ (add-hook 'LaTeX-fill-newline-hook 'TeX-fold-update-at-point nil t)
+ (add-hook 'TeX-after-insert-macro-hook
+ (lambda ()
+ (when (and TeX-fold-mode TeX-fold-auto)
+ (save-excursion
+ (backward-char)
+ (or (TeX-fold-item 'macro)
+ (TeX-fold-item 'math)
+ (TeX-fold-item 'env))))))
+ ;; Update the `TeX-fold-*-spec-list-internal' variables.
+ (dolist (elt '("macro" "env" "math"))
+ (set (intern (format "TeX-fold-%s-spec-list-internal" elt))
+ ;; Append the value of `TeX-fold-*-spec-list' to the
+ ;; mode-specific `<mode-prefix>-fold-*-spec-list' variable.
+ (append (symbol-value (intern (format "TeX-fold-%s-spec-list"
+ elt)))
+ (let ((symbol (intern (format "%s-fold-%s-spec-list"
+ (TeX-mode-prefix) elt))))
+ (when (boundp symbol)
+ (symbol-value symbol)))))))
+ (kill-local-variable 'search-invisible)
+ (remove-hook 'post-command-hook 'TeX-fold-post-command t)
+ (remove-hook 'LaTeX-fill-newline-hook 'TeX-fold-update-at-point t)
+ (TeX-fold-clearout-buffer))
+ (TeX-set-mode-name))
+
+;;;###autoload
+(defalias 'tex-fold-mode 'TeX-fold-mode)
+
+(provide 'tex-fold)
+
+;;; tex-fold.el ends here