From: Thien-Thi Nguyen Date: Wed, 14 Sep 2005 00:29:50 +0000 (+0000) Subject: (hs-hide-comments-when-hiding-all): Remove autoload cookie. X-Git-Tag: emacs-pretest-22.0.90~7115 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=a5b101dc44c7039d43efeef32995a0a56e31e003;p=emacs.git (hs-hide-comments-when-hiding-all): Remove autoload cookie. (hs-allow-nesting): New user var. (hs-discard-overlays): Skip "internal" overlays if nesting allowed. (hs-hide-block-at-point): When nesting allowed, if there is already an overlay in place, delete it. (hs-safety-is-job-n): Delete func; remove call sites. (hs-hide-level-recursive): Don't pre-clean if nesting allowed. (hs-overlay-at): New func. (hs-already-hidden-p, hs-show-block): Use it. (hs-hide-all): Don't pre-clean if nesting allowed. (hs-show-all): Temporarily disallow nesting around call to `hs-discard-overlays'. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 94f9f4cf37e..b53df64a0be 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,19 @@ +2005-09-14 Thien-Thi Nguyen + + * progmodes/hideshow.el + (hs-hide-comments-when-hiding-all): Remove autoload cookie. + (hs-allow-nesting): New user var. + (hs-discard-overlays): Skip "internal" overlays if nesting allowed. + (hs-hide-block-at-point): When nesting allowed, + if there is already an overlay in place, delete it. + (hs-safety-is-job-n): Delete func; remove call sites. + (hs-hide-level-recursive): Don't pre-clean if nesting allowed. + (hs-overlay-at): New func. + (hs-already-hidden-p, hs-show-block): Use it. + (hs-hide-all): Don't pre-clean if nesting allowed. + (hs-show-all): Temporarily disallow + nesting around call to `hs-discard-overlays'. + 2005-09-14 Chong Yidong * mouse.el (mouse-major-mode-menu): Make `prefix' optional. diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index ac62fd00f30..ddc0e277200 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -6,7 +6,7 @@ ;; Author: Thien-Thi Nguyen ;; Dan Nicolaescu ;; Keywords: C C++ java lisp tools editing comments blocks hiding outlines -;; Maintainer-Version: +;; 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,7 +243,6 @@ :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 @@ -307,6 +306,11 @@ whitespace. Case does not matter.") (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,12 +416,19 @@ Note that `mode-line-format' is buffer-local.") ;; support functions (defun hs-discard-overlays (from to) - "Delete hideshow overlays in region defined by FROM and 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)))) - (dolist (ov (overlays-in from to)) - (when (overlay-get ov 'hs) - (delete-overlay ov)))) + (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,19 +543,16 @@ and then further adjusted to be at the end of the line." ;; `q' is the point at the end of the block (progn (hs-forward-sexp mdata 1) (end-of-line) - (point)))) + (point))) + ov) (when (and (< p (point)) (> (count-lines p q) 1)) - (hs-discard-overlays p q) + (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-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 @@ -658,7 +666,8 @@ 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-discard-overlays minp maxp) ; eliminate weirdness + (unless hs-allow-nesting + (hs-discard-overlays minp maxp)) (goto-char minp) (while (progn (forward-comment (buffer-size)) @@ -668,7 +677,6 @@ 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) (goto-char maxp)) (defmacro hs-life-goes-on (&rest body) @@ -682,6 +690,15 @@ and `case-fold-search' are both t." (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,12 +712,7 @@ and `case-fold-search' are both t." ;; 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))) + (hs-overlay-at (point)))) (defun hs-c-like-adjust-block-beginning (initial) "Adjust INITIAL, the buffer position after `hs-block-start-regexp'. @@ -724,7 +736,8 @@ 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-discard-overlays (point-min) (point-max)) ; eliminate weirdness + (unless hs-allow-nesting + (hs-discard-overlays (point-min) (point-max))) (goto-char (point-min)) (let ((count 0) (re (concat "\\(" @@ -752,8 +765,7 @@ If `hs-hide-comments-when-hiding-all' is non-nil, also hide the comments." (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)) + (message "Hiding ... %d" (setq count (1+ count)))))) (beginning-of-line) (message "Hiding all blocks ... done") (run-hooks 'hs-hide-hook))) @@ -763,7 +775,8 @@ If `hs-hide-comments-when-hiding-all' is non-nil, also hide the comments." (interactive) (hs-life-goes-on (message "Showing all blocks ...") - (hs-discard-overlays (point-min) (point-max)) + (let ((hs-allow-nesting nil)) + (hs-discard-overlays (point-min) (point-max))) (message "Showing all blocks ... done") (run-hooks 'hs-show-hook))) @@ -782,7 +795,6 @@ Upon completion, point is repositioned and the normal hook (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) @@ -794,17 +806,15 @@ See documentation for functions `hs-hide-block' and `run-hooks'." (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)) + (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,7 +830,6 @@ See documentation for functions `hs-hide-block' and `run-hooks'." (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) @@ -832,7 +841,6 @@ The hook `hs-hide-hook' is run; see `run-hooks'." (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 ()