[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.56 
emacs/lisp/progmodes/hideshow.el:1.57
*** emacs/lisp/progmodes/hideshow.el:1.56       Wed Sep 14 00:16:25 2005
--- emacs/lisp/progmodes/hideshow.el    Wed Sep 14 00:27:40 2005
***************
*** 6,12 ****
  ;; Author: Thien-Thi Nguyen <address@hidden>
  ;;      Dan Nicolaescu <address@hidden>
  ;; Keywords: C C++ java lisp tools editing comments blocks hiding outlines
! ;; Maintainer-Version:
  ;; Time-of-Day-Author-Most-Likely-to-be-Recalcitrant: early morning
  
  ;; This file is part of GNU Emacs.
--- 6,12 ----
  ;; Author: Thien-Thi Nguyen <address@hidden>
  ;;      Dan Nicolaescu <address@hidden>
  ;; Keywords: C C++ java lisp tools editing comments blocks hiding outlines
! ;; Maintainer-Version: 5.65.2.2
  ;; Time-of-Day-Author-Most-Likely-to-be-Recalcitrant: early morning
  
  ;; This file is part of GNU Emacs.
***************
*** 243,249 ****
    :prefix "hs-"
    :group 'languages)
  
- ;;;###autoload
  (defcustom hs-hide-comments-when-hiding-all t
    "*Hide the comments too when you do an `hs-hide-all'."
    :type 'boolean
--- 243,248 ----
***************
*** 307,312 ****
--- 306,316 ----
  (defvar hs-hide-all-non-comment-function nil
    "*Function called if non-nil when doing `hs-hide-all' for non-comments.")
  
+ (defvar hs-allow-nesting nil
+   "*If non-nil, hiding remembers internal blocks.
+ This means that when the outer block is shown again, any
+ previously hidden internal blocks remain hidden.")
+ 
  (defvar hs-hide-hook nil
    "*Hook called (with `run-hooks') at the end of commands to hide text.
  These commands include the toggling commands (when the result is to hide
***************
*** 412,423 ****
  ;; support functions
  
  (defun hs-discard-overlays (from to)
!   "Delete hideshow overlays in region defined by FROM and TO."
    (when (< to from)
      (setq from (prog1 to (setq to from))))
!   (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.
--- 416,434 ----
  ;; support functions
  
  (defun hs-discard-overlays (from to)
!   "Delete hideshow overlays in region defined by FROM and TO.
! Skip \"internal\" overlays if `hs-allow-nesting' is non-nil."
    (when (< to from)
      (setq from (prog1 to (setq to from))))
!   (if hs-allow-nesting
!       (let (ov)
!         (while (> to (setq from (next-overlay-change from)))
!           (when (setq ov (hs-overlay-at from))
!             (setq from (overlay-end ov))
!             (delete-overlay ov))))
!     (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.
***************
*** 532,550 ****
                ;; `q' is the point at the end of the block
                (progn (hs-forward-sexp mdata 1)
                       (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 ()
-   "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)))
- 
  (defun hs-inside-comment-p ()
    "Return non-nil if point is inside a comment, otherwise nil.
  Actually, return a list containing the buffer position of the start
--- 543,558 ----
                ;; `q' is the point at the end of the block
                (progn (hs-forward-sexp mdata 1)
                       (end-of-line)
!                      (point)))
!              ov)
          (when (and (< p (point)) (> (count-lines p q) 1))
!           (cond ((and hs-allow-nesting (setq ov (hs-overlay-at p)))
!                  (delete-overlay ov))
!                 ((not hs-allow-nesting)
!                  (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-inside-comment-p ()
    "Return non-nil if point is inside a comment, otherwise nil.
  Actually, return a list containing the buffer position of the start
***************
*** 658,664 ****
      (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))
--- 666,673 ----
      (setq minp (1+ (point)))
      (funcall hs-forward-sexp-func 1)
      (setq maxp (1- (point))))
!   (unless hs-allow-nesting
!     (hs-discard-overlays minp maxp))
    (goto-char minp)
    (while (progn
             (forward-comment (buffer-size))
***************
*** 668,674 ****
          (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)
    (goto-char maxp))
  
  (defmacro hs-life-goes-on (&rest body)
--- 677,682 ----
***************
*** 682,687 ****
--- 690,704 ----
  
  (put 'hs-life-goes-on 'edebug-form-spec '(&rest form))
  
+ (defun hs-overlay-at (position)
+   "Return hideshow overlay at POSITION, or nil if none to be found."
+   (let ((overlays (overlays-at position))
+         ov found)
+     (while (and (not found) (setq ov (car overlays)))
+       (setq found (and (overlay-get ov 'hs) ov)
+             overlays (cdr overlays)))
+     found))
+ 
  (defun hs-already-hidden-p ()
    "Return non-nil if point is in an already-hidden block, otherwise nil."
    (save-excursion
***************
*** 695,706 ****
            ;; point is inside a block
            (goto-char (match-end 0)))))
      (end-of-line)
!     (let ((overlays (overlays-at (point)))
!           (found nil))
!       (while (and (not found) (overlayp (car overlays)))
!         (setq found (overlay-get (car overlays) 'hs)
!               overlays (cdr overlays)))
!       found)))
  
  (defun hs-c-like-adjust-block-beginning (initial)
    "Adjust INITIAL, the buffer position after `hs-block-start-regexp'.
--- 712,718 ----
            ;; point is inside a block
            (goto-char (match-end 0)))))
      (end-of-line)
!     (hs-overlay-at (point))))
  
  (defun hs-c-like-adjust-block-beginning (initial)
    "Adjust INITIAL, the buffer position after `hs-block-start-regexp'.
***************
*** 724,730 ****
    (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 "\\("
--- 736,743 ----
    (hs-life-goes-on
     (message "Hiding all blocks ...")
     (save-excursion
!      (unless hs-allow-nesting
!        (hs-discard-overlays (point-min) (point-max)))
       (goto-char (point-min))
       (let ((count 0)
             (re (concat "\\("
***************
*** 752,759 ****
                 (if (> (count-lines (car c-reg) (nth 1 c-reg)) 1)
                     (hs-hide-block-at-point t c-reg)
                   (goto-char (nth 1 c-reg))))))
!          (message "Hiding ... %d" (setq count (1+ count)))))
!      (hs-safety-is-job-n))
     (beginning-of-line)
     (message "Hiding all blocks ... done")
     (run-hooks 'hs-hide-hook)))
--- 765,771 ----
                 (if (> (count-lines (car c-reg) (nth 1 c-reg)) 1)
                     (hs-hide-block-at-point t c-reg)
                   (goto-char (nth 1 c-reg))))))
!          (message "Hiding ... %d" (setq count (1+ count))))))
     (beginning-of-line)
     (message "Hiding all blocks ... done")
     (run-hooks 'hs-hide-hook)))
***************
*** 763,769 ****
    (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)))
  
--- 775,782 ----
    (interactive)
    (hs-life-goes-on
     (message "Showing all blocks ...")
!    (let ((hs-allow-nesting nil))
!      (hs-discard-overlays (point-min) (point-max)))
     (message "Showing all blocks ... done")
     (run-hooks 'hs-show-hook)))
  
***************
*** 782,788 ****
             (looking-at hs-block-start-regexp)
             (hs-find-block-beginning))
         (hs-hide-block-at-point end c-reg)
-        (hs-safety-is-job-n)
         (run-hooks 'hs-hide-hook))))))
  
  (defun hs-show-block (&optional end)
--- 795,800 ----
***************
*** 794,810 ****
    (hs-life-goes-on
     (or
      ;; first see if we have something at the end of the line
!     (catch 'eol-begins-hidden-region-p
!       (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))
            p q)
--- 806,820 ----
    (hs-life-goes-on
     (or
      ;; first see if we have something at the end of the line
!     (let ((ov (hs-overlay-at (save-excursion (end-of-line) (point))))
!           (here (point)))
!       (when ov
!         (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)
!         t))
      ;; not immediately obvious, look for a suitable block
      (let ((c-reg (hs-inside-comment-p))
            p q)
***************
*** 820,826 ****
        (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))))
  
  (defun hs-hide-level (arg)
--- 830,835 ----
***************
*** 832,838 ****
       (message "Hiding blocks ...")
       (hs-hide-level-recursive arg (point-min) (point-max))
       (message "Hiding blocks ... done"))
-    (hs-safety-is-job-n)
     (run-hooks 'hs-hide-hook)))
  
  (defun hs-toggle-hiding ()
--- 841,846 ----