summaryrefslogtreecommitdiff
path: root/lisp/progmodes/hideshow.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/progmodes/hideshow.el')
-rw-r--r--lisp/progmodes/hideshow.el269
1 files changed, 140 insertions, 129 deletions
diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el
index 7013c3856e3..07fcda385ef 100644
--- a/lisp/progmodes/hideshow.el
+++ b/lisp/progmodes/hideshow.el
@@ -5,7 +5,7 @@
;; Author: Thien-Thi Nguyen <ttn@gnu.org>
;; Dan Nicolaescu <dann@ics.uci.edu>
;; Keywords: C C++ java lisp tools editing comments blocks hiding outlines
-;; Maintainer-Version: 5.31
+;; Maintainer-Version: 5.58.2.3
;; Time-of-Day-Author-Most-Likely-to-be-Recalcitrant: early morning
;; This file is part of GNU Emacs.
@@ -58,7 +58,7 @@
;;
;; (load-library "hideshow")
;; (add-hook 'X-mode-hook ; other modes similarly
-;; '(lambda () (hs-minor-mode 1)))
+;; (lambda () (hs-minor-mode 1)))
;;
;; where X = {emacs-lisp,c,c++,perl,...}. You can also manually toggle
;; hideshow minor mode by typing `M-x hs-minor-mode'. After hideshow is
@@ -133,14 +133,24 @@
;; variable `hs-special-modes-alist'. Packages that use hideshow should
;; do something like:
;;
-;; (let ((my-mode-hs-info '(my-mode "{{" "}}" ...)))
-;; (if (not (member my-mode-hs-info hs-special-modes-alist))
-;; (setq hs-special-modes-alist
-;; (cons my-mode-hs-info hs-special-modes-alist))))
+;; (add-to-list 'hs-special-modes-alist '(my-mode "{{" "}}" ...))
;;
;; If you have an entry that works particularly well, consider
;; submitting it for inclusion in hideshow.el. See docstring for
;; `hs-special-modes-alist' for more info on the entry format.
+;;
+;; See also variable `hs-set-up-overlay' for per-block customization of
+;; appearance or other effects associated with overlays. For example:
+;;
+;; (setq hs-set-up-overlay
+;; (defun my-display-code-line-counts (ov)
+;; (when (eq 'code (overlay-get ov 'hs))
+;; (overlay-put ov 'display
+;; (propertize
+;; (format " ... <%d>"
+;; (count-lines (overlay-start ov)
+;; (overlay-end ov)))
+;; 'face 'font-lock-type-face)))))
;; * Bugs
;;
@@ -180,9 +190,9 @@
;; In the case of `vc-diff', here is a less invasive workaround:
;;
;; (add-hook 'vc-before-checkin-hook
-;; '(lambda ()
-;; (goto-char (point-min))
-;; (hs-show-block)))
+;; (lambda ()
+;; (goto-char (point-min))
+;; (hs-show-block)))
;;
;; Unfortunately, these workarounds do not restore hideshow state.
;; If someone figures out a better way, please let me know.
@@ -223,6 +233,7 @@
;;; Code:
(require 'easymenu)
+(eval-when-compile (require 'cl))
;;---------------------------------------------------------------------------
;; user-configurable variables
@@ -265,8 +276,7 @@ This has effect iff `search-invisible' is set to `open'."
'((c-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning)
(c++-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning)
(bibtex-mode ("^@\\S(*\\(\\s(\\)" 1))
- (java-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning)
- )
+ (java-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning))
"*Alist for initializing the hideshow variables for different modes.
Each element has the form
(MODE START END COMMENT-START FORWARD-SEXP-FUNC ADJUST-BEG-FUNC).
@@ -307,6 +317,24 @@ a block), `hs-hide-all', `hs-hide-block' and `hs-hide-level'.")
These commands include the toggling commands (when the result is to show
a block), `hs-show-all' and `hs-show-block'..")
+(defvar hs-set-up-overlay nil
+ "*Function called with one arg, OV, a newly initialized overlay.
+Hideshow puts a unique overlay on each range of text to be hidden
+in the buffer. Here is a simple example of how to use this variable:
+
+ (defun display-code-line-counts (ov)
+ (when (eq 'code (overlay-get ov 'hs))
+ (overlay-put ov 'display
+ (format \"... / %d\"
+ (count-lines (overlay-start ov)
+ (overlay-end ov))))))
+
+ (setq hs-set-up-overlay 'display-code-line-counts)
+
+This example shows how to get information from the overlay as well
+as how to set its `display' property. See `hs-make-overlay' and
+info node `(elisp)Overlays'.")
+
;;---------------------------------------------------------------------------
;; internal variables
@@ -378,28 +406,6 @@ Note that `mode-line-format' is buffer-local.")
;;---------------------------------------------------------------------------
;; system dependency
-; ;; xemacs compatibility
-; (when (string-match "xemacs\\|lucid" emacs-version)
-; ;; use pre-packaged compatiblity layer
-; (require 'overlay))
-;
-; ;; xemacs and emacs-19 compatibility
-; (when (or (not (fboundp 'add-to-invisibility-spec))
-; (not (fboundp 'remove-from-invisibility-spec)))
-; ;; `buffer-invisibility-spec' mutators snarfed from Emacs 20.3 lisp/subr.el
-; (defun add-to-invisibility-spec (arg)
-; (cond
-; ((or (null buffer-invisibility-spec) (eq buffer-invisibility-spec t))
-; (setq buffer-invisibility-spec (list arg)))
-; (t
-; (setq buffer-invisibility-spec
-; (cons arg buffer-invisibility-spec)))))
-; (defun remove-from-invisibility-spec (arg)
-; (when buffer-invisibility-spec
-; (setq buffer-invisibility-spec
-; (delete arg buffer-invisibility-spec)))))
-
-;; hs-match-data
(defalias 'hs-match-data 'match-data)
;;---------------------------------------------------------------------------
@@ -409,12 +415,38 @@ Note that `mode-line-format' is buffer-local.")
"Delete hideshow overlays in region defined by FROM and TO."
(when (< to from)
(setq from (prog1 to (setq to from))))
- (let ((ovs (overlays-in from to)))
- (while ovs
- (let ((ov (car ovs)))
- (when (overlay-get ov 'hs)
- (delete-overlay ov)))
- (setq ovs (cdr ovs)))))
+ (dolist (ov (overlays-in from to))
+ (when (overlay-get ov 'hs)
+ (delete-overlay ov))))
+
+(defun hs-make-overlay (b e kind &optional b-offset e-offset)
+ "Return a new overlay in region defined by B and E with type KIND.
+KIND is either `code' or `comment'. Optional fourth arg B-OFFSET
+when added to B specifies the actual buffer position where the block
+begins. Likewise for optional fifth arg E-OFFSET. If unspecified
+they are taken to be 0 (zero). The following properties are set
+in the overlay: 'invisible 'hs 'hs-b-offset 'hs-e-offset. Also,
+depending on variable `hs-isearch-open', the following properties may
+be present: 'isearch-open-invisible 'isearch-open-invisible-temporary.
+If variable `hs-set-up-overlay' is non-nil it should specify a function
+to call with the newly initialized overlay."
+ (unless b-offset (setq b-offset 0))
+ (unless e-offset (setq e-offset 0))
+ (let ((ov (make-overlay b e))
+ (io (if (eq 'block hs-isearch-open)
+ ;; backward compatibility -- `block'<=>`code'
+ 'code
+ hs-isearch-open)))
+ (overlay-put ov 'invisible 'hs)
+ (overlay-put ov 'hs kind)
+ (overlay-put ov 'hs-b-offset b-offset)
+ (overlay-put ov 'hs-e-offset e-offset)
+ (when (or (eq io t) (eq io kind))
+ (overlay-put ov 'isearch-open-invisible 'hs-isearch-show)
+ (overlay-put ov 'isearch-open-invisible-temporary
+ 'hs-isearch-show-temporary))
+ (when hs-set-up-overlay (funcall hs-set-up-overlay ov))
+ ov))
(defun hs-isearch-show (ov)
"Delete overlay OV, and set `hs-headline' to nil.
@@ -433,43 +465,28 @@ OV is shown.
This function is meant to be used as the `isearch-open-invisible-temporary'
property of an overlay."
(setq hs-headline
- (if hide-p
- nil
- (or hs-headline
- (let ((start (overlay-start ov)))
- (buffer-substring
- (save-excursion (goto-char start)
- (beginning-of-line)
- (skip-chars-forward " \t")
- (point))
- start)))))
+ (if hide-p
+ nil
+ (or hs-headline
+ (let ((start (overlay-start ov)))
+ (buffer-substring
+ (save-excursion (goto-char start)
+ (beginning-of-line)
+ (skip-chars-forward " \t")
+ (point))
+ start)))))
(force-mode-line-update)
+ ;; handle `display' property specially
+ (let (value)
+ (if hide-p
+ (when (setq value (overlay-get ov 'hs-isearch-display))
+ (overlay-put ov 'display value)
+ (overlay-put ov 'hs-isearch-display nil))
+ (when (setq value (overlay-get ov 'display))
+ (overlay-put ov 'hs-isearch-display value)
+ (overlay-put ov 'display nil))))
(overlay-put ov 'invisible (and hide-p 'hs)))
-(defun hs-flag-region (from to flag)
- "Hide or show lines from FROM to TO, according to FLAG.
-If FLAG is nil then text is shown, while if FLAG is non-nil the text is
-hidden. FLAG must be one of the symbols `code' or `comment', depending
-on what kind of block is to be hidden."
- (save-excursion
- ;; first clear it all out
- (hs-discard-overlays from to)
- ;; now create overlays if needed
- (when flag
- (let ((overlay (make-overlay from to)))
- (overlay-put overlay 'invisible 'hs)
- (overlay-put overlay 'hs flag)
- (when (or (eq hs-isearch-open t)
- (eq hs-isearch-open flag)
- ;; deprecated backward compatibility -- `block'<=>`code'
- (and (eq 'block hs-isearch-open)
- (eq 'code flag)))
- (overlay-put overlay 'isearch-open-invisible 'hs-isearch-show)
- (overlay-put overlay
- 'isearch-open-invisible-temporary
- 'hs-isearch-show-temporary))
- overlay))))
-
(defun hs-forward-sexp (match-data arg)
"Adjust point based on MATCH-DATA and call `hs-forward-sexp-func' w/ ARG.
Original match data is restored upon return."
@@ -481,9 +498,10 @@ Original match data is restored upon return."
(defun hs-hide-comment-region (beg end &optional repos-end)
"Hide a region from BEG to END, marking it as a comment.
Optional arg REPOS-END means reposition at end."
- (hs-flag-region (progn (goto-char beg) (end-of-line) (point))
- (progn (goto-char end) (end-of-line) (point))
- 'comment)
+ (let ((beg-eol (progn (goto-char beg) (end-of-line) (point)))
+ (end-eol (progn (goto-char end) (end-of-line) (point))))
+ (hs-discard-overlays beg-eol end-eol)
+ (hs-make-overlay beg-eol end-eol 'comment beg end))
(goto-char (if repos-end end beg)))
(defun hs-hide-block-at-point (&optional end comment-reg)
@@ -516,17 +534,16 @@ and then further adjusted to be at the end of the line."
(end-of-line)
(point))))
(when (and (< p (point)) (> (count-lines p q) 1))
- (overlay-put (hs-flag-region p q 'code)
- 'hs-ofs
- (- pure-p p)))
+ (hs-discard-overlays p q)
+ (hs-make-overlay p q 'code (- pure-p p)))
(goto-char (if end q (min p pure-p)))))))
(defun hs-safety-is-job-n ()
"Warn if `buffer-invisibility-spec' does not contain symbol `hs'."
- (unless (and (listp buffer-invisibility-spec)
- (assq 'hs buffer-invisibility-spec))
- (message "Warning: `buffer-invisibility-spec' does not contain hs!!")
- (sit-for 2)))
+ (unless (and (listp buffer-invisibility-spec)
+ (assq 'hs buffer-invisibility-spec))
+ (message "Warning: `buffer-invisibility-spec' does not contain hs!!")
+ (sit-for 2)))
(defun hs-inside-comment-p ()
"Return non-nil if point is inside a comment, otherwise nil.
@@ -543,10 +560,15 @@ as cdr."
(let ((q (point)))
(when (or (looking-at hs-c-start-regexp)
(re-search-backward hs-c-start-regexp (point-min) t))
+ ;; first get to the beginning of this comment...
+ (while (and (not (bobp))
+ (= (point) (progn (forward-comment -1) (point))))
+ (forward-char -1))
+ ;; ...then extend backwards
(forward-comment (- (buffer-size)))
(skip-chars-forward " \t\n\f")
(let ((p (point))
- (not-hidable nil))
+ (hidable t))
(beginning-of-line)
(unless (looking-at (concat "[ \t]*" hs-c-start-regexp))
;; we are in this situation: (example)
@@ -565,19 +587,19 @@ as cdr."
(while (and (< (point) q)
(> (point) p)
(not (looking-at hs-c-start-regexp)))
- (setq p (point));; use this to avoid an infinite cycle
+ (setq p (point)) ;; use this to avoid an infinite cycle
(forward-comment 1)
(skip-chars-forward " \t\n\f"))
(when (or (not (looking-at hs-c-start-regexp))
(> (point) q))
;; we cannot hide this comment block
- (setq not-hidable t)))
+ (setq hidable nil)))
;; goto the end of the comment
(forward-comment (buffer-size))
(skip-chars-backward " \t\n\f")
(end-of-line)
(when (>= (point) q)
- (list (if not-hidable nil p) (point))))))))
+ (list (and hidable p) (point))))))))
(defun hs-grok-mode-type ()
"Set up hideshow variables for new buffers.
@@ -635,7 +657,7 @@ Return point, or nil if original point was not in a block."
(setq minp (1+ (point)))
(funcall hs-forward-sexp-func 1)
(setq maxp (1- (point))))
- (hs-flag-region minp maxp nil) ; eliminate weirdness
+ (hs-discard-overlays minp maxp) ; eliminate weirdness
(goto-char minp)
(while (progn
(forward-comment (buffer-size))
@@ -645,7 +667,7 @@ Return point, or nil if original point was not in a block."
(hs-hide-level-recursive (1- arg) minp maxp)
(goto-char (match-beginning hs-block-start-mdata-select))
(hs-hide-block-at-point t)))
- (hs-safety-is-job-n)
+ (hs-safety-is-job-n)
(goto-char maxp))
(defmacro hs-life-goes-on (&rest body)
@@ -675,8 +697,8 @@ and `case-fold-search' are both t."
(let ((overlays (overlays-at (point)))
(found nil))
(while (and (not found) (overlayp (car overlays)))
- (setq found (overlay-get (car overlays) 'hs)
- overlays (cdr overlays)))
+ (setq found (overlay-get (car overlays) 'hs)
+ overlays (cdr overlays)))
found)))
(defun hs-c-like-adjust-block-beginning (initial)
@@ -701,7 +723,7 @@ If `hs-hide-comments-when-hiding-all' is non-nil, also hide the comments."
(hs-life-goes-on
(message "Hiding all blocks ...")
(save-excursion
- (hs-flag-region (point-min) (point-max) nil) ; eliminate weirdness
+ (hs-discard-overlays (point-min) (point-max)) ; eliminate weirdness
(goto-char (point-min))
(let ((count 0)
(re (concat "\\("
@@ -724,7 +746,7 @@ If `hs-hide-comments-when-hiding-all' is non-nil, also hide the comments."
(funcall hs-hide-all-non-comment-function)
(hs-hide-block-at-point t)))
;; found a comment, probably
- (let ((c-reg (hs-inside-comment-p))) ; blech!
+ (let ((c-reg (hs-inside-comment-p))) ; blech!
(when (and c-reg (car c-reg))
(if (> (count-lines (car c-reg) (nth 1 c-reg)) 1)
(hs-hide-block-at-point t c-reg)
@@ -740,7 +762,7 @@ If `hs-hide-comments-when-hiding-all' is non-nil, also hide the comments."
(interactive)
(hs-life-goes-on
(message "Showing all blocks ...")
- (hs-flag-region (point-min) (point-max) nil)
+ (hs-discard-overlays (point-min) (point-max))
(message "Showing all blocks ... done")
(run-hooks 'hs-show-hook)))
@@ -772,18 +794,15 @@ See documentation for functions `hs-hide-block' and `run-hooks'."
(or
;; first see if we have something at the end of the line
(catch 'eol-begins-hidden-region-p
- (let ((here (point))
- (ovs (save-excursion (end-of-line) (overlays-at (point)))))
- (while ovs
- (let ((ov (car ovs)))
- (when (overlay-get ov 'hs)
- (goto-char
- (cond (end (overlay-end ov))
- ((eq 'comment (overlay-get ov 'hs)) here)
- (t (+ (overlay-start ov) (overlay-get ov 'hs-ofs)))))
- (delete-overlay ov)
- (throw 'eol-begins-hidden-region-p t)))
- (setq ovs (cdr ovs)))
+ (let ((here (point)))
+ (dolist (ov (save-excursion (end-of-line) (overlays-at (point))))
+ (when (overlay-get ov 'hs)
+ (goto-char
+ (cond (end (overlay-end ov))
+ ((eq 'comment (overlay-get ov 'hs)) here)
+ (t (+ (overlay-start ov) (overlay-get ov 'hs-b-offset)))))
+ (delete-overlay ov)
+ (throw 'eol-begins-hidden-region-p t)))
nil))
;; not immediately obvious, look for a suitable block
(let ((c-reg (hs-inside-comment-p))
@@ -797,7 +816,7 @@ See documentation for functions `hs-hide-block' and `run-hooks'."
(setq p (point)
q (progn (hs-forward-sexp (hs-match-data t) 1) (point)))))
(when (and p q)
- (hs-flag-region p q nil)
+ (hs-discard-overlays p q)
(goto-char (if end q (1+ p)))))
(hs-safety-is-job-n)
(run-hooks 'hs-show-hook))))
@@ -870,9 +889,9 @@ Key bindings:
(interactive "P")
(setq hs-headline nil
- hs-minor-mode (if (null arg)
- (not hs-minor-mode)
- (> (prefix-numeric-value arg) 0)))
+ hs-minor-mode (if (null arg)
+ (not hs-minor-mode)
+ (> (prefix-numeric-value arg) 0)))
(if hs-minor-mode
(progn
(hs-grok-mode-type)
@@ -912,27 +931,19 @@ Key bindings:
)))))
;; some housekeeping
-(or (assq 'hs-minor-mode minor-mode-map-alist)
- (setq minor-mode-map-alist
- (cons (cons 'hs-minor-mode hs-minor-mode-map)
- minor-mode-map-alist)))
-(or (assq 'hs-minor-mode minor-mode-alist)
- (setq minor-mode-alist (append minor-mode-alist
- (list '(hs-minor-mode " hs")))))
+(add-to-list 'minor-mode-map-alist (cons 'hs-minor-mode hs-minor-mode-map))
+(add-to-list 'minor-mode-alist '(hs-minor-mode " hs") t)
;; make some variables permanently buffer-local
-(let ((vars '(hs-minor-mode
- hs-c-start-regexp
- hs-block-start-regexp
- hs-block-start-mdata-select
- hs-block-end-regexp
- hs-forward-sexp-func
- hs-adjust-block-beginning)))
- (while vars
- (let ((var (car vars)))
- (make-variable-buffer-local var)
- (put var 'permanent-local t))
- (setq vars (cdr vars))))
+(dolist (var '(hs-minor-mode
+ hs-c-start-regexp
+ hs-block-start-regexp
+ hs-block-start-mdata-select
+ hs-block-end-regexp
+ hs-forward-sexp-func
+ hs-adjust-block-beginning))
+ (make-variable-buffer-local var)
+ (put var 'permanent-local t))
;;---------------------------------------------------------------------------
;; that's it
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-26 07:23:59 +0000