(hs-set-up-overlay): New user var.

(hs-make-overlay): New function.
(hs-isearch-show-temporary): Handle `display' overlay prop specially.
(hs-flag-region): Delete function.
(hs-hide-comment-region): No longer use `hs-flag-region'.
Instead, use `hs-discard-overlays' and `hs-make-overlay'.
(hs-hide-block-at-point): Likewise.
(hs-hide-level-recursive): Use `hs-discard-overlays'.
(hs-hide-all, hs-show-all): Likewise.
(hs-show-block): Likewise.
Also, use overlay prop `hs-b-offset', not `hs-ofs'.

2 files changed, 95 insertions, 36 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index aebf3cc4285..18ceb9cfefa 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,17 @@
+2004-12-26  Thien-Thi Nguyen  <ttn@gnu.org>
+
+        * progmodes/hideshow.el (hs-set-up-overlay): New user var.
+        (hs-make-overlay): New function.
+        (hs-isearch-show-temporary): Handle `display' overlay prop specially.
+        (hs-flag-region): Delete function.
+        (hs-hide-comment-region): No longer use `hs-flag-region'.
+        Instead, use `hs-discard-overlays' and `hs-make-overlay'.
+        (hs-hide-block-at-point): Likewise.
+        (hs-hide-level-recursive): Use `hs-discard-overlays'.
+        (hs-hide-all, hs-show-all): Likewise.
+        (hs-show-block): Likewise.
+        Also, use overlay prop `hs-b-offset', not `hs-ofs'.
+
 2004-12-24  Thien-Thi Nguyen  <ttn@gnu.org>
 
         * progmodes/hideshow.el: Require `cl' when compiling.
diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el
index 3bd5dd2a1f6..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.39.2.8
+;; Maintainer-Version: 5.58.2.3
 ;; Time-of-Day-Author-Most-Likely-to-be-Recalcitrant: early morning
 
 ;; This file is part of GNU Emacs.
@@ -138,6 +138,19 @@
 ;; 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
 ;;
@@ -304,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
 
@@ -388,6 +419,35 @@ Note that `mode-line-format' is buffer-local.")
     (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.
 
@@ -416,32 +476,17 @@ property of an overlay."
                                  (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."
@@ -453,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)
@@ -488,9 +534,8 @@ 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 ()
@@ -612,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))
@@ -678,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 "\\("
@@ -717,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)))
 
@@ -755,7 +800,7 @@ See documentation for functions `hs-hide-block' and `run-hooks'."
             (goto-char
              (cond (end (overlay-end ov))
                    ((eq 'comment (overlay-get ov 'hs)) here)
-                   (t (+ (overlay-start ov) (overlay-get ov 'hs-ofs)))))
+                   (t (+ (overlay-start ov) (overlay-get ov 'hs-b-offset)))))
             (delete-overlay ov)
             (throw 'eol-begins-hidden-region-p t)))
         nil))
@@ -771,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))))