Первоначальный черновик (23 июля 2014 г.): первый черновик.
РЕДАКТИРОВАТЬ (23 июля 2014 г.): Второй черновик. Добавлены счетчик и цикл while в попытке справиться с вложенными ситуациями, содержащими одно и то же регулярное выражение.
(defvar beg-xsl-regexp
"\\(\<xsl:\\)\\([^ >]*\\)\\([^>]*\\)\\(\>\\)"
"Regexp matching the beginning of the folded region.")
(defun toggle-xsl-block ()
"When FLAG is non-nil, hide the region. Otherwise make it visible. For this
function to work, the cursor must be on the same line as the beginning regexp."
(interactive)
(require 'outline)
(cond
((or
(looking-at beg-xsl-regexp)
(let ((line-begin (save-excursion (beginning-of-line 1) (point))))
(save-excursion
(re-search-backward "\<" line-begin t)
(looking-at beg-xsl-regexp)))
(let ((line-begin (save-excursion (beginning-of-line 1) (point))))
(save-excursion
(re-search-backward "\<xsl:" line-begin t)
(looking-at beg-xsl-regexp)))
(let ((line-end (save-excursion (end-of-line 1) (point))))
(save-excursion
(re-search-forward "\<xsl:" line-end t)
(backward-char 5)
(looking-at beg-xsl-regexp))))
(let* (
congratulations
(i 0)
(beg-1 (match-beginning 0))
(flag (not (get-char-property (match-end 0) 'invisible)))
(begin-fold (match-end 0))
end-fold
(base-flag-match (regexp-quote
(buffer-substring-no-properties (match-beginning 2) (match-end 2))))
(beg-flag-match (concat "\<xsl:" base-flag-match))
(end-flag-match (concat "\</xsl:" base-flag-match "\>"))
(go-fish (concat "\</xsl:" base-flag-match "\>")) )
(save-excursion
(when (save-excursion (re-search-forward end-flag-match nil t))
(catch 'done
(while t
(re-search-forward end-flag-match nil t)
(when
(>
(save-excursion (re-search-backward beg-flag-match beg-1 t i) (point))
beg-1)
(setq i (1+ i)))
(when
(=
(save-excursion (re-search-backward beg-flag-match beg-1 t i) (point))
beg-1)
(setq congratulations t)
(throw 'done nil)))))
(if congratulations
(progn
(setq end-fold (point))
(outline-flag-region begin-fold end-fold flag)
(cond
(flag
(overlay-put (make-overlay begin-fold end-fold) 'display "\u25be"))
(t
(mapc 'delete-overlay (overlays-in begin-fold end-fold)))))
(user-error "Error locating an ending match for: %s." go-fish)))
(if (> (point) begin-fold)
(goto-char begin-fold)) ))
(t
(message "You are not on a line containing the beginning regexp."))))