Require `easymenu'. Rework to use easymenu. Remove eol ws.

(hs-hide-level-recursive, hs-hide-level): Add.

(hs-unbalance-handler-method): Delete.
(hs-show-block-at-point): Always use `top-level' unbalanced-handler case.

1 files changed, 284 insertions, 251 deletions

diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el
index 885ac0c6bee..a8f323e1dd5 100644
--- a/lisp/progmodes/hideshow.el
+++ b/lisp/progmodes/hideshow.el
@@ -1,11 +1,11 @@
 ;;; hideshow.el --- minor mode cmds to selectively display blocks of code
 
-;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation
+;; Copyright (C) 1994, 95, 96, 97, 98 Free Software Foundation
 
 ;; Author: Thien-Thi Nguyen <ttn@netcom.com>
-;; Maintainer: Dan Nicolaescu <done@ece.arizona.edu>
-;; Version: 4.0
+;;      Dan Nicolaescu <done@ece.arizona.edu>
 ;; Keywords: C C++ java lisp tools editing comments blocks hiding outlines
+;; Maintainer-Version: 4.20
 ;; Time-of-Day-Author-Most-Likely-to-be-Recalcitrant: early morning
 
 ;; This file is part of GNU Emacs.
@@ -25,47 +25,83 @@
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
-;; LCD Archive Entry:
-;; hideshow|Thien-Thi Nguyen|ttn@netcom.com|
-;; minor mode commands to selectively display blocks of code|
-;; 18-Oct-1994|3.4|~/modes/hideshow.el.Z|
-
 ;;; Commentary:
 
-;; This file provides `hs-minor-mode'.  When active, six commands:
-;;   hs-{hide,show}-{all,block}, hs-show-region and hs-minor-mode
-;; are available.  They implement block hiding and showing.  Blocks are
-;; defined in mode-specific way.  In c-mode or c++-mode, they are simply
-;; curly braces, while in lisp-ish modes they are parens.  Multi-line
-;; comments (c-mode) can also be hidden.  The command M-x hs-minor-mode
-;; toggles the minor mode or sets it (similar to outline minor mode).
-;; See documentation for each command for more info.
+;; - Commands provided
+;;
+;; This file provides `hs-minor-mode'.  When active, seven commands:
+;;
+;;   hs-{hide,show}-{all,block}, hs-show-region,
+;;   hs-hide-level and hs-minor-mode
 ;;
-;; The variable `hs-unbalance-handler-method' controls hideshow's behavior
-;; in the case of "unbalanced parentheses".  See doc for more info.
+;; are available, implementing block hiding and showing.  Blocks are
+;; defined per mode.  In c-mode or c++-mode, they are simply curly braces,
+;; while in Lisp-ish modes they are parens.  Multi-line comments can also
+;; be hidden.  The command `M-x hs-minor-mode' toggles the minor mode or
+;; sets it (similar to outline minor mode).
 
-;; Suggested usage:
+;; - Customization
+;;
+;; Variables control things thusly:
+;;
+;; hs-hide-comments-when-hiding-all -- self-explanatory!
+;; hs-show-hidden-short-form   -- whether or not the last line in a form
+;;                                is omitted (saving screen space)
+;; hs-isearch-open             -- what kind of hidden blocks to open when
+;;                                doing isearch
+;; hs-special-modes-alist      -- keeps at bay hideshow's heuristics with
+;;                                respect to block definitions
+;;
+;; Hooks are run after some commands:
+;;
+;;   hs-hide-hook     in      hs-hide-block, hs-hide-all, hs-hide-level
+;;   hs-show-hook             hs-show-block, hs-show-all, hs-show-region
+;;
+;; See docs for each variable or hook for more info.
 
+;; - Suggested usage
+;;
 ;; (load-library "hideshow")
 ;; (add-hook 'X-mode-hook 'hs-minor-mode)   ; other modes similarly
 ;;
 ;; where X = {emacs-lisp,c,c++,perl,...}.  See the doc for the variable
 ;; `hs-special-modes-alist' if you'd like to use hideshow w/ other modes.
 
-;; Etc:
+;; - Bugs / caveats
+;;
+;; 1.  Hideshow does not work w/ emacs 18 because emacs 18 lacks the
+;; function `forward-comment' (among other things).  If someone writes
+;; this, please send me a copy.
+;;
+;; 2.  Users of cc-mode.el should not hook hideshow into
+;; c-mode-common-hook since at that stage of the call sequence, the
+;; variables `comment-start' and `comment-end' are not yet provided.
+;; Instead, use c-mode-hook and c++-mode-hook as suggested above.
 
-;; Bug reports and fixes welcome (comments, too).  Thanks go to
-;;      Dean Andrews <adahome@ix.netcom.com>
-;;      Preston F. Crow <preston.f.crow@dartmouth.edu>
-;;      Gael Marziou <gael@gnlab030.grenoble.hp.com>
-;;      Keith Sheffield <sheff@edcsgw2.cr.usgs.gov>
-;;      Jan Djarv <jan.djarv@sa.erisoft.se>
-;;      Lars Lindberg <qhslali@aom.ericsson.se>
-;;      Alf-Ivar Holm <alfh@ifi.uio.no>
-;; for valuable feedback, code and bug reports.
+;; - Thanks and feedback
+;;
+;; Thanks go to the following people for valuable ideas, code and bug
+;; reports.
+;;     adahome@ix.netcom.com           Dean Andrews
+;;     alfh@ifi.uio.no                 Alf-Ivar Holm
+;;     gael@gnlab030.grenoble.hp.com   Gael Marziou
+;;     jan.djarv@sa.erisoft.se         Jan Djarv
+;;     preston.f.crow@dartmouth.edu    Preston F. Crow
+;;     qhslali@aom.ericsson.se         Lars Lindberg
+;;     sheff@edcsgw2.cr.usgs.gov       Keith Sheffield
+;;     ware@cis.ohio-state.edu         Pete Ware
+;;
+;; Special thanks go to Dan Nicolaescu <done@ece.arizona.edu>, who
+;; reimplemented hideshow using overlays (rather than selective display),
+;; added isearch magic, folded in custom.el compatibility, generalized
+;; comment handling, incorporated mouse support, and maintained the code
+;; in general.  Version 4.0 is largely due to his efforts.
+;;
+;; Correspondance welcome; please indicate version number.
 
 ;;; Code:
 
+(require 'easymenu)
 
 ;;;----------------------------------------------------------------------------
 ;;; user-configurable variables
@@ -76,47 +112,47 @@
   :group 'languages)
 
 ;;;###autoload
-(defcustom hs-hide-comments-when-hiding-all t 
-  "Hide the comments too when you do an `hs-hide-all'." 
+(defcustom hs-hide-comments-when-hiding-all t
+  "Hide the comments too when you do an `hs-hide-all'."
   :type 'boolean
   :group 'hideshow)
 
 ;;;###autoload
 (defcustom hs-show-hidden-short-form t
   "Leave only the first line visible in a hidden block.
-If t only the first line is visible when a block is in the hidden state, 
-else both the first line and the last line are showed. Also if t and 
-`hs-adjust-block-beginning' is set, it is used also.
+If non-nil only the first line is visible when a block is in the
+hidden state, else both the first line and the last line are shown.
+A nil value disables `hs-adjust-block-beginning', which see.
 
-An example of how this works: (in c-mode)
+An example of how this works: (in C mode)
 original:
-                      
-/* My function main
-   some more stuff about main
-*/
-int
-main(void)
-{
-  int x=0;
-  return 0;
-}
-
-
-hidden and hs-show-hidden-short-form is nil
-/* My function main...
-*/                        
-int
-main(void)
-{...
-}
-
-hidden and hs-show-hidden-short-form is t
-/* My function main...
-int                   
-main(void)...
-
-For latest you have to be on the line containing the ellipsis when 
-you do `hs-show-block'."
+
+  /* My function main
+     some more stuff about main
+  */
+  int
+  main(void)
+  {
+    int x=0;
+    return 0;
+  }
+
+
+hidden and `hs-show-hidden-short-form' is nil
+  /* My function main...
+  */
+  int
+  main(void)
+  {...
+  }
+
+hidden and `hs-show-hidden-short-form' is t
+  /* My function main...
+  int
+  main(void)...
+
+For the last case you have to be on the line containing the
+ellipsis when you do `hs-show-block'."
   :type 'boolean
   :group 'hideshow)
 
@@ -128,35 +164,23 @@ hide all the comments at the beginning of the file."
   :group 'hideshow)
 
 (defcustom hs-isearch-open 'block
-"What kind of hidden blocks to open when doing `isearch'.
-It can have the following values:
-    `block'     open only  blocks
-    `comment'   open only comments
-    t           open all of them
-    nil         don't open any.
-This only has effect iff `search-invisible' is set to `open'."
-  :type '(choice (const :tag "open only  blocks" block)
+  "What kind of hidden blocks to open when doing `isearch'.
+One of the following values:
+
+  block   -- open only blocks
+  comment -- open only comments
+  t       -- open both blocks and comments
+  nil     -- open neither blocks nor comments
+
+This has effect iff `search-invisible' is set to `open'."
+  :type '(choice (const :tag "open only blocks" block)
                  (const :tag "open only comments" comment)
                  (const :tag "open both blocks and comments" t)
                  (const :tag "don't open any of them" nil))
   :group 'hideshow)
 
-(defvar hs-unbalance-handler-method 'top-level
-  "*Symbol representing how \"unbalanced parentheses\" should be handled.
-This error is usually signaled by `hs-show-block'.  One of four values:
-`top-level', `next-line', `signal' or `ignore'.  Default is `top-level'.
-
-- `top-level' -- Show top-level block containing the currently troublesome
-                 block.
-- `next-line' -- Use the fact that, for an already hidden block, its end
-                 will be on the next line.  Attempt to show this block.
-- `signal' -- Pass the error through, stopping execution.
-- `ignore' -- Ignore the error, continuing execution.
-
-Values other than these four will be interpreted as `signal'.") 
-
 ;;;###autoload
-(defvar hs-special-modes-alist 
+(defvar hs-special-modes-alist
   '((c-mode "{" "}" nil nil hs-c-like-adjust-block-beginning)
     (c++-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning)
     (java-mode "\\(\\(\\([ \t]*\\(\\(abstract\\|final\\|native\\|p\\(r\\(ivate\\|otected\\)\\|ublic\\)\\|s\\(tatic\\|ynchronized\\)\\)[ \t\n]+\\)*[.a-zA-Z0-9_:]+[ \t\n]*\\(\\[[ \t\n]*\\][ \t\n]*\\)?\\([a-zA-Z0-9_:]+[ \t\n]*\\)([^)]*)\\([ \n\t]+throws[ \t\n][^{]+\\)?\\)\\|\\([ \t]*static[^{]*\\)\\)[ \t\n]*{\\)" "}" "/[*/]" java-hs-forward-sexp hs-c-like-adjust-block-beginning))
@@ -168,9 +192,9 @@ Values other than these four will be interpreted as `signal'.")
 ;(defvar hsj-throws)
 ;(defvar hsj-static)
 
-;(setq hsj-public 
+;(setq hsj-public
 ;      (concat "[ \t]*\\("
-;             (regexp-opt '("public" "private" "protected" "abstract" 
+;             (regexp-opt '("public" "private" "protected" "abstract"
 ;                           "synchronized" "static" "final" "native") 1)
 ;             "[ \t\n]+\\)*"))
 
@@ -198,37 +222,28 @@ Values other than these four will be interpreted as `signal'.")
 ;                                     "\\)"
 ;                                "\\)"
 ;                                   "[ \t\n]*{"
-;                             "\\)"  
+;                             "\\)"
 ;                                   ))
 
   "*Alist for initializing the hideshow variables for different modes.
-It has the form 
-(MODE START-RE END-RE COMMENT-START-RE FORWARD-SEXP-FUNC ADJUST-BEG-FUNC).
-If present, hideshow will use these values for the start and end regexps,
-respectively.  Since Algol-ish languages do not have single-character
-block delimiters, the function `forward-sexp' which is used by hideshow
-doesn't work.  In this case, if a similar function is provided, you can
-register it and have hideshow use it instead of `forward-sexp'.  To add
-more values, use
-
-\t(pushnew '(new-mode st-re end-re function-name)
-\t      hs-special-modes-alist :test 'equal)
-
-For example:
-
-\t(pushnew '(simula-mode \"begin\" \"end\" \"!\" simula-next-statement)
-\t      hs-special-modes-alist :test 'equal)
-
-See the documentation for `hs-adjust-block-beginning' to see what
-is the use of ADJUST-BEG-FUNC.
-
-If any of those is left nil, hideshow will try to guess some values, see
-`hs-grok-mode-type' for this.
+It has the form
+  (MODE START END COMMENT-START FORWARD-SEXP-FUNC ADJUST-BEG-FUNC).
+If present, hideshow will use these values as regexps for start, end
+and comment-start, respectively.  Since Algol-ish languages do not have
+single-character block delimiters, the function `forward-sexp' used
+by hideshow doesn't work.  In this case, if a similar function is
+available, you can register it and have hideshow use it instead of
+`forward-sexp'.  See the documentation for `hs-adjust-block-beginning'
+to see what is the use of ADJUST-BEG-FUNC.
+
+If any of those is left nil, hideshow will try to guess some values
+using function `hs-grok-mode-type'.
 
 Note that the regexps should not contain leading or trailing whitespace.")
 
 (defvar hs-hide-hook nil
-  "*Hooks called at the end of `hs-hide-all' and `hs-hide-block'.")
+  "*Hooks called at the end of commands to hide text.
+These commands include `hs-hide-all', `hs-hide-block' and `hs-hide-level'.")
 
 (defvar hs-show-hook nil
   "*Hooks called at the end of commands to show text.
@@ -251,8 +266,8 @@ Use the command `hs-minor-mode' to toggle this variable.")
 ;  "Menu bar for hideshow minor mode (Xemacs only).")
 
 (defvar hs-c-start-regexp nil
-  "Regexp for beginning of comments.  
-Differs from mode-specific comment regexps in that 
+  "Regexp for beginning of comments.
+Differs from mode-specific comment regexps in that
 surrounding whitespace is stripped.")
 
 (defvar hs-block-start-regexp nil
@@ -262,29 +277,29 @@ surrounding whitespace is stripped.")
   "Regexp for end of block.")
 
 (defvar hs-forward-sexp-func 'forward-sexp
-  "Function used to do a forward-sexp.
+  "Function used to do a `forward-sexp'.
 Should change for Algol-ish modes.  For single-character block
 delimiters -- ie, the syntax table regexp for the character is
-either `(' or `)' -- `hs-forward-sexp-func' would just be `forward-sexp'.
-For other modes such as simula, a more specialized function
-is necessary.")
+either `(' or `)' -- `hs-forward-sexp-func' would just be
+`forward-sexp'.  For other modes such as simula, a more specialized
+function is necessary.")
 
 (defvar hs-adjust-block-beginning nil
   "Function used to tweak the block beginning.
-It has effect only if `hs-show-hidden-short-form' is t. The block it
-is hidden from the point returned by this function, as opposed to
-hiding it from the point returned when searching
+It has effect only if `hs-show-hidden-short-form' is non-nil.
+The block it is hidden from the point returned by this function,
+as opposed to hiding it from the point returned when searching
 `hs-block-start-regexp'.  In c-like modes, if we wish to also hide the
 curly braces (if you think they occupy too much space on the screen),
 this function should return the starting point (at the end of line) of
-the hidden region.  
+the hidden region.
 
 It is called with a single argument ARG which is the the position in
 buffer after the block beginning.
 
 It should return the position from where we should start hiding.
 
-It should not move the point.  
+It should not move the point.
 
 See `hs-c-like-adjust-block-beginning' for an example of using this.")
 
@@ -303,10 +318,10 @@ See `hs-c-like-adjust-block-beginning' for an example of using this.")
 
 ;; snarfed from outline.el;
 (defun hs-flag-region (from to flag)
-  "Hides or shows 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. Actualy flag is realy either `comment' or `block' depending on
-what kind of block it is suppose to hide."
+  "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.  Actually flag is really either `comment' or `block'
+depending on what kind of block it is suppose to hide."
     (save-excursion
       (goto-char from)
       (end-of-line)
@@ -316,8 +331,8 @@ what kind of block it is suppose to hide."
             ;; Make overlay hidden and intangible.
             (overlay-put overlay 'invisible 'hs)
             (overlay-put overlay 'hs t)
-            (when (or (eq hs-isearch-open t) (eq hs-isearch-open flag)) 
-                (overlay-put overlay 'isearch-open-invisible 
+            (when (or (eq hs-isearch-open t) (eq hs-isearch-open flag))
+                (overlay-put overlay 'isearch-open-invisible
                              'hs-isearch-open-invisible))
             (overlay-put overlay 'intangible t)))))
 
@@ -345,38 +360,42 @@ what kind of block it is suppose to hide."
           (setq overlays (cdr overlays))))))
 
 (defun hs-hide-block-at-point (&optional end comment-reg)
-  "Hide block iff on block beginning, optional END means reposition at end.
-COMMENT-REG is a list of the form (BEGIN . END) and specifies the limits 
-of the comment, or nil if the block is not a comment." 
+  "Hide block iff on block beginning.
+Optional arg END means reposition at end.
+Optional arg COMMENT-REG is a list of the form (BEGIN . END) and
+specifies the limits of the comment, or nil if the block is not
+a comment."
   (if comment-reg
-      (progn 
+      (progn
         ;; goto the end of line at the end of the comment
         (goto-char (nth 1 comment-reg))
         (unless hs-show-hidden-short-form (forward-line -1))
         (end-of-line)
-        (hs-flag-region (car comment-reg)  (point) 'comment) 
+        (hs-flag-region (car comment-reg)  (point) 'comment)
         (goto-char (if end (nth 1 comment-reg) (car comment-reg))))
       (if (looking-at hs-block-start-regexp)
           (let* ((p ;; p is the point at the end of the block beginning
-                  (if (and  hs-show-hidden-short-form 
+                  (if (and  hs-show-hidden-short-form
                             hs-adjust-block-beginning)
                       ;; we need to adjust the block beginning
-                      (funcall hs-adjust-block-beginning (match-end 0)) 
+                      (funcall hs-adjust-block-beginning (match-end 0))
                     (match-end 0)))
                  ;; q is the point at the end of the block
                  (q (progn (funcall hs-forward-sexp-func 1) (point))))
             ;; position the point so we can call `hs-flag-region'
             (unless hs-show-hidden-short-form (forward-line -1))
             (end-of-line)
-            (if (and (< p (point)) (> (count-lines p q) 
+            (if (and (< p (point)) (> (count-lines p q)
                                       (if hs-show-hidden-short-form 1 2)))
                 (hs-flag-region p (point) 'block))
             (goto-char (if end q p))))))
 
 (defun hs-show-block-at-point (&optional end comment-reg)
-  "Show block iff on block beginning.  Optional END means reposition at end.
-COMMENT-REG is a list of the forme (BEGIN . END) and specifies the limits 
-of the comment. It should be nil when hiding a block." 
+  "Show block iff on block beginning.
+Optional arg END means reposition at end.
+Optional arg COMMENT-REG is a list of the forme (BEGIN . END) and
+specifies the limits of the comment. It should be nil when hiding
+a block."
   (if comment-reg
       (when (car comment-reg)
         (hs-flag-region (car comment-reg) (nth 1 comment-reg) nil)
@@ -389,29 +408,17 @@ of the comment. It should be nil when hiding a block."
                       (funcall hs-forward-sexp-func 1)
                       (point))
                   (error
-                   (cond
-                    ((eq hs-unbalance-handler-method 'ignore)
-                     ;; just ignore this block
-                     (point))
-                    ((eq hs-unbalance-handler-method 'top-level)
-                     ;; try to get out of rat's nest and expose the whole func
-                     (if (/= (current-column) 0) (beginning-of-defun))
-                     (setq p (point))
-                     (re-search-forward (concat "^" hs-block-start-regexp)
-                                        (point-max) t 2)
-                     (point))
-                    ((eq hs-unbalance-handler-method 'next-line)
-                     ;; assumption is that user knows what s/he's doing
-                     (beginning-of-line) (setq p (point))
-                     (end-of-line 2) (point))
-                    (t
-                     ;; pass error through -- this applies to `signal', too
-                     (signal (car error) (cdr error))))))))
+                   ;; try to get out of rat's nest and expose the whole func
+                   (if (/= (current-column) 0) (beginning-of-defun))
+                   (setq p (point))
+                   (re-search-forward (concat "^" hs-block-start-regexp)
+                                      (point-max) t 2)
+                   (point)))))
           (hs-flag-region p q nil)
           (goto-char (if end (1+ (point)) p))))))
 
 (defun hs-safety-is-job-n ()
-  "Warn `buffer-invisibility-spec' does not contain hs."
+  "Warn if `buffer-invisibility-spec' does not contain hs."
     (if (or buffer-invisibility-spec (assq 'hs buffer-invisibility-spec) )
         nil
       (message "Warning: `buffer-invisibility-spec' does not contain hs!!")
@@ -419,29 +426,29 @@ of the comment. It should be nil when hiding a block."
 
 (defun hs-hide-initial-comment-block ()
   (interactive)
-  "Hides the first block of comments in a file.
-The best usage is in `hs-minor-mode-hook', it hides all the comments at the
-file beginning, so if you have huge RCS logs you won't see them!"
+  "Hide the first block of comments in a file.
+This is useful when a part of `hs-minor-mode-hook', especially with
+huge header-comment RCS logs."
       (let ((p (point))
             c-reg)
         (goto-char (point-min))
         (skip-chars-forward " \t\n^L")
         (setq c-reg (hs-inside-comment-p))
         ;; see if we have enough comment lines to hide
-        (if (and c-reg (> (count-lines (car c-reg) (nth 1 c-reg)) 
+        (if (and c-reg (> (count-lines (car c-reg) (nth 1 c-reg))
                           (if hs-show-hidden-short-form 1 2)))
             (hs-hide-block)
           (goto-char p))))
 
 (defun hs-inside-comment-p ()
-  "Returns non-nil if point is inside a comment, otherwise nil.
-Actually, returns a list containing the buffer position of the start 
-and the end of the comment. A comment block can be hided only if on its 
-starting line there are only white spaces preceding the actual comment 
-beginning, if we are inside of a comment but this condition is not 
+  "Return non-nil if point is inside a comment, otherwise nil.
+Actually, returns a list containing the buffer position of the start
+and the end of the comment.  A comment block can be hidden only if on
+its starting line there is only whitespace preceding the actual comment
+beginning.  If we are inside of a comment but this condition is not met,
 we return a list having a nil as its car and the end of comment position
 as cdr."
-  (save-excursion 
+  (save-excursion
     ;; the idea is to look backwards for a comment start regexp, do a
     ;; forward comment, and see if we are inside, then extend extend
     ;; forward and backward as long as we have comments
@@ -460,20 +467,20 @@ as cdr."
             ;;                ) ; comment
             ;;                 ^
             ;;   the point was here before doing (beginning-of-line)
-            ;; here we should advance till the next comment which 
+            ;; here we should advance till the next comment which
             ;; eventually has only white spaces preceding it on the same
-            ;; line 
+            ;; line
             (goto-char p)
             (forward-comment 1)
             (skip-chars-forward " \t\n")
             (setq p (point))
-            (while (and (< (point) q) 
-                        (> (point) p) 
+            (while (and (< (point) q)
+                        (> (point) p)
                         (not (looking-at hs-c-start-regexp)))
               (setq p (point))  ;; use this to avoid an infinit cycle.
               (forward-comment 1)
               (skip-chars-forward " \t\n"))
-            (if (or (not (looking-at hs-c-start-regexp)) 
+            (if (or (not (looking-at hs-c-start-regexp))
                     (> (point) q))
                 ;; we cannot hide this comment block
                 (setq not-hidable t)))
@@ -485,14 +492,18 @@ as cdr."
               (list (if not-hidable nil p) (point))))))))
 
 (defun hs-grok-mode-type ()
-  "Setup variables for new buffers where applicable."
+  "Set up hideshow variables for new buffers.
+If `hs-special-modes-alist' has information associated with the
+current buffer's major mode, use that.
+Otherwise, guess start, end and comment-start regexps; forward-sexp
+function; and adjust-block-beginning function."
   (when (and (boundp 'comment-start)
              (boundp 'comment-end))
     (let ((lookup (assoc major-mode hs-special-modes-alist)))
       (setq hs-block-start-regexp (or (nth 1 lookup) "\\s\(")
             hs-block-end-regexp (or (nth 2 lookup) "\\s\)")
             hs-c-start-regexp (or (nth 3 lookup)
-                                  (let ((c-start-regexp 
+                                  (let ((c-start-regexp
                                          (regexp-quote comment-start)))
                                     (if (string-match " +$" c-start-regexp)
                                          (substring c-start-regexp 0 (1- (match-end 0)))
@@ -501,7 +512,7 @@ as cdr."
             hs-adjust-block-beginning (nth 5 lookup)))))
 
 (defun hs-find-block-beginning ()
-  "Repositions point at block-start.
+  "Reposition point at block-start.
 Return point, or nil if top-level."
   (let (done
         (try-again t)
@@ -518,7 +529,7 @@ Return point, or nil if top-level."
       (setq try-again nil)
       (if (and (re-search-backward both-regexps (point-min) t)
                (match-beginning 1)) ; found a block beginning
-          (if (save-match-data (hs-inside-comment-p)) 
+          (if (save-match-data (hs-inside-comment-p))
               ;;but it was inside a comment, so we have to look for
               ;;it again
               (setq try-again t)
@@ -527,13 +538,13 @@ Return point, or nil if top-level."
         ;; we found a block end, or we reached the beginning of the
         ;; buffer look to see if we were on a block beginning when we
         ;; started
-        (if (and 
+        (if (and
              (re-search-forward hs-block-start-regexp (point-max) t)
-             (or 
+             (or
               (and (>= here (match-beginning 0)) (< here (match-end 0)))
               (and hs-show-hidden-short-form hs-adjust-block-beginning
-                   (save-match-data 
-                     (= 1 (count-lines 
+                   (save-match-data
+                     (= 1 (count-lines
                            (funcall hs-adjust-block-beginning
                                     (match-end 0)) here))))))
               (setq done (match-beginning 0)))))
@@ -553,13 +564,30 @@ Return point, or nil if top-level."
     (goto-char (or done here))
     done))
 
+(defun hs-hide-level-recursive (arg minp maxp)
+  "Hide blocks ARG levels below this block recursively."
+  (when (hs-find-block-beginning)
+    (setq minp (1+ (point)))
+    (forward-sexp)
+    (setq maxp (1- (point))))
+  (hs-flag-region minp maxp ?\n)        ; eliminate weirdness
+  (goto-char minp)
+  (while (progn
+           (forward-comment (buffer-size))
+           (re-search-forward hs-block-start-regexp maxp t))
+    (if (> arg 1)
+        (hs-hide-level-recursive (1- arg) minp maxp)
+      (goto-char (match-beginning 0))
+      (hs-hide-block-at-point t)))
+    (hs-safety-is-job-n)
+  (goto-char maxp))
+
 (defmacro hs-life-goes-on (&rest body)
-  "Executes optional BODY iff variable `hs-minor-mode' is non-nil."
+  "Execute optional BODY iff variable `hs-minor-mode' is non-nil."
   `(let ((inhibit-point-motion-hooks t))
-     (when hs-minor-mode 
+     (when hs-minor-mode
        ,@body)))
 
-
 (put 'hs-life-goes-on 'edebug-form-spec '(&rest form))
 
 (defun hs-already-hidden-p ()
@@ -593,9 +621,9 @@ Return point, or nil if top-level."
       (forward-sexp 1))))
 
 (defun hs-c-like-adjust-block-beginning (arg)
-  "Function to be assigned to `hs-adjust-block-beginning' for C like modes.
-Arg is a position in buffer just after {. This goes back to the end of
-the function header. The purpose is to save some space on the screen
+  "Function to be assigned to `hs-adjust-block-beginning' for C-like modes.
+Arg is a position in buffer just after {.  This goes back to the end of
+the function header.  The purpose is to save some space on the screen
 when displaying hidden blocks."
   (save-excursion
     (goto-char arg)
@@ -608,22 +636,22 @@ when displaying hidden blocks."
 
 ;;;###autoload
 (defun hs-hide-all ()
-  "Hides all top-level blocks, displaying only first and last lines.
-It moves point to the beginning of the line, and it runs the normal hook
-`hs-hide-hook'.  See documentation for `run-hooks'. 
-If `hs-hide-comments-when-hiding-all' is t also hides the comments."
+  "Hide all top-level blocks, displaying only first and last lines.
+Move point to the beginning of the line, and it run the normal hook
+`hs-hide-hook'.  See documentation for `run-hooks'.
+If `hs-hide-comments-when-hiding-all' is t, also hide the comments."
   (interactive)
   (hs-life-goes-on
    (message "Hiding all blocks ...")
    (save-excursion
      (hs-flag-region (point-min) (point-max) nil) ; eliminate weirdness
      (goto-char (point-min))
-     (if hs-hide-comments-when-hiding-all 
+     (if hs-hide-comments-when-hiding-all
          (let (c-reg
                (count 0)
-               (block-and-comment-re  ;; this should match 
+               (block-and-comment-re  ;; this should match
                 (concat "\\(^"        ;; the block beginning and comment start
-                        hs-block-start-regexp  
+                        hs-block-start-regexp
                         "\\)\\|\\(" hs-c-start-regexp "\\)")))
            (while (re-search-forward block-and-comment-re (point-max) t)
              (if (match-beginning 1) ;; we have found a block beginning
@@ -634,7 +662,7 @@ If `hs-hide-comments-when-hiding-all' is t also hides the comments."
                ;;found a comment
                (setq c-reg (hs-inside-comment-p))
                (if (and c-reg (car c-reg))
-                   (if (> (count-lines (car c-reg) (nth 1 c-reg)) 
+                   (if (> (count-lines (car c-reg) (nth 1 c-reg))
                           (if hs-show-hidden-short-form 1 2))
                        (progn
                          (hs-hide-block-at-point t c-reg)
@@ -643,7 +671,7 @@ If `hs-hide-comments-when-hiding-all' is t also hides the comments."
        (let ((count 0)
              (top-level-re (concat "^" hs-block-start-regexp))
              (buf-size (buffer-size)))
-         (while 
+         (while
              (progn
                (forward-comment buf-size)
                (re-search-forward top-level-re (point-max) t))
@@ -656,8 +684,8 @@ If `hs-hide-comments-when-hiding-all' is t also hides the comments."
    (run-hooks 'hs-hide-hook)))
 
 (defun hs-show-all ()
-  "Shows all top-level blocks.
-This does not change point; it runs the normal hook `hs-show-hook'.
+  "Show all top-level blocks.
+Point is unchanged; run the normal hook `hs-show-hook'.
 See documentation for `run-hooks'."
   (interactive)
   (hs-life-goes-on
@@ -667,17 +695,17 @@ See documentation for `run-hooks'."
    (run-hooks 'hs-show-hook)))
 
 (defun hs-hide-block (&optional end)
-  "Selects a block and hides it.  
-With prefix arg, reposition at end. Block is defined as a sexp for
-lispish modes, mode-specific otherwise. Comments are blocks, too.
-Upon completion, point is at repositioned and the normal hook
+  "Select a block and hide it.
+With prefix arg, reposition at end.  Block is defined as a sexp for
+Lispish modes, mode-specific otherwise.  Comments are blocks, too.
+Upon completion, point is repositioned and the normal hook
 `hs-hide-hook' is run.  See documentation for `run-hooks'."
   (interactive "P")
   (hs-life-goes-on
    (let ((c-reg (hs-inside-comment-p)))
      (cond
-      ((and c-reg (or (null (nth 0 c-reg)) 
-                      (<= (count-lines (car c-reg) (nth 1 c-reg)) 
+      ((and c-reg (or (null (nth 0 c-reg))
+                      (<= (count-lines (car c-reg) (nth 1 c-reg))
                           (if hs-show-hidden-short-form 1 2))))
            (message "Not enough comment lines to hide!"))
       ((or c-reg (looking-at hs-block-start-regexp)
@@ -687,9 +715,9 @@ Upon completion, point is at repositioned and the normal hook
        (run-hooks 'hs-hide-hook))))))
 
 (defun hs-show-block (&optional end)
-  "Selects a block and shows it.
-With prefix arg, reposition at end. Upon completion, point is
-repositioned and the normal hook `hs-show-hook' is run.  
+  "Select a block and show it.
+With prefix arg, reposition at end.  Upon completion, point is
+repositioned and the normal hook `hs-show-hook' is run.
 See documentation for `hs-hide-block' and `run-hooks'."
   (interactive "P")
   (hs-life-goes-on
@@ -703,9 +731,9 @@ See documentation for `hs-hide-block' and `run-hooks'."
              (run-hooks 'hs-show-hook))))))
 
 (defun hs-show-region (beg end)
-  "Shows all lines from BEG to END, without doing any block analysis.
-Note:`hs-show-region' is intended for use when `hs-show-block' signals
-`unbalanced parentheses' and so is an emergency measure only.  You may
+  "Show all lines from BEG to END, without doing any block analysis.
+Note: `hs-show-region' is intended for use when `hs-show-block' signals
+\"unbalanced parentheses\" and so is an emergency measure only.  You may
 become very confused if you use this command indiscriminately."
   (interactive "r")
   (hs-life-goes-on
@@ -713,9 +741,20 @@ become very confused if you use this command indiscriminately."
    (hs-safety-is-job-n)
    (run-hooks 'hs-show-hook)))
 
+(defun hs-hide-level (arg)
+  "Hide all blocks ARG levels below this block."
+  (interactive "p")
+  (hs-life-goes-on
+   (save-excursion
+     (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)))
+
 ;;;###autoload
 (defun hs-mouse-toggle-hiding (e)
-  "Toggles hiding/showing of a block. 
+  "Toggle hiding/showing of a block.
 Should be bound to a mouse key."
   (interactive "@e")
   (mouse-set-point e)
@@ -728,13 +767,13 @@ Should be bound to a mouse key."
   "Toggle hideshow minor mode.
 With ARG, turn hideshow minor mode on if ARG is positive, off otherwise.
 When hideshow minor mode is on, the menu bar is augmented with hideshow
-commands and the hideshow commands are enabled.  
+commands and the hideshow commands are enabled.
 The value '(hs . t) is added to `buffer-invisibility-spec'.
-Last, the normal hook `hs-minor-mode-hook' is run; see the doc 
+Last, the normal hook `hs-minor-mode-hook' is run; see the doc
 for `run-hooks'.
 
-The main commands are: `hs-hide-all', `hs-show-all', `hs-hide-block'
-and `hs-show-block'. 
+The main commands are: `hs-hide-all', `hs-show-all', `hs-hide-block',
+`hs-show-block', `hs-hide-level' and `hs-show-region'.
 Also see the documentation for the variable `hs-show-hidden-short-form'.
 
 Turning hideshow minor mode off reverts the menu bar and the
@@ -777,28 +816,26 @@ Key bindings:
 (if hs-minor-mode-map
     nil
   (setq hs-minor-mode-map (make-sparse-keymap))
-  ;; I beleive there is nothing bound on this keys
-  (define-key hs-minor-mode-map "\C-ch" 'hs-hide-block)
-  (define-key hs-minor-mode-map "\C-cs" 'hs-show-block)
-  (define-key hs-minor-mode-map "\C-cH" 'hs-hide-all)
-  (define-key hs-minor-mode-map "\C-cS" 'hs-show-all)
-  (define-key hs-minor-mode-map "\C-cR" 'hs-show-region)
-  
-  (define-key hs-minor-mode-map [S-mouse-2] 'hs-mouse-toggle-hiding)
-
-  ;; should we use easymenu here?
-  (define-key hs-minor-mode-map [menu-bar Hide/Show]
-    (cons "Hide/Show" (make-sparse-keymap "Hide/Show")))
-  (define-key hs-minor-mode-map [menu-bar Hide/Show  hs-show-region]
-    '("Show Region" . hs-show-region))
-  (define-key hs-minor-mode-map [menu-bar Hide/Show hs-show-all]
-    '("Show All" . hs-show-all))
-  (define-key hs-minor-mode-map [menu-bar Hide/Show hs-hide-all]
-    '("Hide All" . hs-hide-all))
-  (define-key hs-minor-mode-map [menu-bar Hide/Show hs-show-block]
-    '("Show Block" . hs-show-block))
-  (define-key hs-minor-mode-map [menu-bar Hide/Show hs-hide-block]
-    '("Hide Block" . hs-hide-block)))
+  (easy-menu-define hs-minor-mode-menu
+    hs-minor-mode-map
+    "Menu used when hideshow minor mode is active."
+    (cons "Hide/Show"
+          (mapcar
+           ;; populate keymap then massage entry for easymenu
+           (lambda (ent)
+             (define-key hs-minor-mode-map (aref ent 2) (aref ent 1))
+             (aset ent 2 (not (vectorp (aref ent 2))))  ; disable mousy stuff
+             ent)
+           ;; I believe there is nothing bound on these keys
+           ;; menu entry      command                key
+           '(["Hide Block"    hs-hide-block          "\C-ch"]
+             ["Show Block"    hs-show-block          "\C-cs"]
+             ["Hide All"      hs-hide-all            "\C-cH"]
+             ["Show All"      hs-show-all            "\C-cS"]
+             ["Hide Level"    hs-hide-level          "\C-cL"]
+             ["Show Region"   hs-show-region         "\C-cR"]
+             ["Toggle Hiding" hs-mouse-toggle-hiding [S-mouse-2]]
+             )))))
 
 ;; some housekeeping
 (or (assq 'hs-minor-mode minor-mode-map-alist)
@@ -809,20 +846,16 @@ Key bindings:
     (setq minor-mode-alist (append minor-mode-alist
                                    (list '(hs-minor-mode " hs")))))
 
-;; make some variables buffer-local
-(make-variable-buffer-local 'hs-minor-mode)
-(make-variable-buffer-local 'hs-c-start-regexp)
-(make-variable-buffer-local 'hs-block-start-regexp)
-(make-variable-buffer-local 'hs-block-end-regexp)
-(make-variable-buffer-local 'hs-forward-sexp-func)
-(make-variable-buffer-local 'hs-adjust-block-beginning)
-(put 'hs-minor-mode 'permanent-local t)
-(put 'hs-c-start-regexp 'permanent-local t)
-(put 'hs-block-start-regexp 'permanent-local t)
-(put 'hs-block-end-regexp 'permanent-local t)
-(put 'hs-forward-sexp-func 'permanent-local t)
-(put 'hs-adjust-block-beginning 'permanent-local t)
-
+;; make some variables permanently buffer-local
+(mapcar (lambda (var)
+          (make-variable-buffer-local var)
+          (put var 'permanent-local t))
+        '(hs-minor-mode
+          hs-c-start-regexp
+          hs-block-start-regexp
+          hs-block-end-regexp
+          hs-forward-sexp-func
+          hs-adjust-block-beginning))
 
 ;;;----------------------------------------------------------------------------
 ;;; that's it