[Emacs-diffs] Changes to emacs/lisp/progmodes/hideshow.el

[Thien-Thi Nguyen]

Index: emacs/lisp/progmodes/hideshow.el
diff -c emacs/lisp/progmodes/hideshow.el:1.50 
emacs/lisp/progmodes/hideshow.el:1.51
*** emacs/lisp/progmodes/hideshow.el:1.50       Fri Dec 24 02:05:30 2004
--- emacs/lisp/progmodes/hideshow.el    Sun Dec 26 19:45:59 2004
***************
*** 5,11 ****
  ;; Author: Thien-Thi Nguyen <address@hidden>
  ;;      Dan Nicolaescu <address@hidden>
  ;; Keywords: C C++ java lisp tools editing comments blocks hiding outlines
! ;; Maintainer-Version: 5.39.2.8
  ;; Time-of-Day-Author-Most-Likely-to-be-Recalcitrant: early morning
  
  ;; This file is part of GNU Emacs.
--- 5,11 ----
  ;; Author: Thien-Thi Nguyen <address@hidden>
  ;;      Dan Nicolaescu <address@hidden>
  ;; Keywords: C C++ java lisp tools editing comments blocks hiding outlines
! ;; 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,143 ****
--- 138,156 ----
  ;; 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,309 ****
--- 317,340 ----
  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,393 ****
--- 419,453 ----
      (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,447 ****
                                   (point))
                   start)))))
    (force-mode-line-update)
    (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."
--- 476,492 ----
                                   (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-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,461 ****
  (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)
    (goto-char (if repos-end end beg)))
  
  (defun hs-hide-block-at-point (&optional end comment-reg)
--- 498,507 ----
  (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."
!   (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,496 ****
                       (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)))
          (goto-char (if end q (min p pure-p)))))))
  
  (defun hs-safety-is-job-n ()
--- 534,541 ----
                       (end-of-line)
                       (point))))
          (when (and (< p (point)) (> (count-lines p q) 1))
!           (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,618 ****
      (setq minp (1+ (point)))
      (funcall hs-forward-sexp-func 1)
      (setq maxp (1- (point))))
!   (hs-flag-region minp maxp nil)        ; eliminate weirdness
    (goto-char minp)
    (while (progn
             (forward-comment (buffer-size))
--- 657,663 ----
      (setq minp (1+ (point)))
      (funcall hs-forward-sexp-func 1)
      (setq maxp (1- (point))))
!   (hs-discard-overlays minp maxp)       ; eliminate weirdness
    (goto-char minp)
    (while (progn
             (forward-comment (buffer-size))
***************
*** 678,684 ****
    (hs-life-goes-on
     (message "Hiding all blocks ...")
     (save-excursion
!      (hs-flag-region (point-min) (point-max) nil) ; eliminate weirdness
       (goto-char (point-min))
       (let ((count 0)
             (re (concat "\\("
--- 723,729 ----
    (hs-life-goes-on
     (message "Hiding all blocks ...")
     (save-excursion
!      (hs-discard-overlays (point-min) (point-max)) ; eliminate weirdness
       (goto-char (point-min))
       (let ((count 0)
             (re (concat "\\("
***************
*** 717,723 ****
    (interactive)
    (hs-life-goes-on
     (message "Showing all blocks ...")
!    (hs-flag-region (point-min) (point-max) nil)
     (message "Showing all blocks ... done")
     (run-hooks 'hs-show-hook)))
  
--- 762,768 ----
    (interactive)
    (hs-life-goes-on
     (message "Showing all blocks ...")
!    (hs-discard-overlays (point-min) (point-max))
     (message "Showing all blocks ... done")
     (run-hooks 'hs-show-hook)))
  
***************
*** 755,761 ****
              (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)))
          nil))
--- 800,806 ----
              (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))
***************
*** 771,777 ****
               (setq p (point)
                     q (progn (hs-forward-sexp (hs-match-data t) 1) (point)))))
        (when (and p q)
!         (hs-flag-region p q nil)
          (goto-char (if end q (1+ p)))))
      (hs-safety-is-job-n)
      (run-hooks 'hs-show-hook))))
--- 816,822 ----
               (setq p (point)
                     q (progn (hs-forward-sexp (hs-match-data t) 1) (point)))))
        (when (and p q)
!         (hs-discard-overlays p q)
          (goto-char (if end q (1+ p)))))
      (hs-safety-is-job-n)
      (run-hooks 'hs-show-hook))))