code.delx.au - gnu-emacs/blob - lisp/progmodes/hideshow.el

   1 ;;; hideshow.el --- minor mode cmds to selectively display blocks of code
   2
   3 ;; Copyright (C) 1994,1995,1996,1997 Free Software Foundation
   4
   5 ;; Author: Thien-Thi Nguyen <ttn@netcom.com>
   6 ;; Maintainer: Dan Nicolaescu <done@ece.arizona.edu>
   7 ;; Version: 4.0
   8 ;; Keywords: C C++ java lisp tools editing comments blocks hiding outlines
   9 ;; Time-of-Day-Author-Most-Likely-to-be-Recalcitrant: early morning
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27
  28 ;; LCD Archive Entry:
  29 ;; hideshow|Thien-Thi Nguyen|ttn@netcom.com|
  30 ;; minor mode commands to selectively display blocks of code|
  31 ;; 18-Oct-1994|3.4|~/modes/hideshow.el.Z|
  32
  33 ;;; Commentary:
  34
  35 ;; This file provides `hs-minor-mode'.  When active, six commands:
  36 ;;   hs-{hide,show}-{all,block}, hs-show-region and hs-minor-mode
  37 ;; are available.  They implement block hiding and showing.  Blocks are
  38 ;; defined in mode-specific way.  In c-mode or c++-mode, they are simply
  39 ;; curly braces, while in lisp-ish modes they are parens.  Multi-line
  40 ;; comments (c-mode) can also be hidden.  The command M-x hs-minor-mode
  41 ;; toggles the minor mode or sets it (similar to outline minor mode).
  42 ;; See documentation for each command for more info.
  43 ;;
  44 ;; The variable `hs-unbalance-handler-method' controls hideshow's behavior
  45 ;; in the case of "unbalanced parentheses".  See doc for more info.
  46
  47 ;; Suggested usage:
  48
  49 ;; (load-library "hideshow")
  50 ;; (add-hook 'X-mode-hook 'hs-minor-mode)   ; other modes similarly
  51 ;;
  52 ;; where X = {emacs-lisp,c,c++,perl,...}.  See the doc for the variable
  53 ;; `hs-special-modes-alist' if you'd like to use hideshow w/ other modes.
  54
  55 ;; Etc:
  56
  57 ;; Bug reports and fixes welcome (comments, too).  Thanks go to
  58 ;;      Dean Andrews <adahome@ix.netcom.com>
  59 ;;      Preston F. Crow <preston.f.crow@dartmouth.edu>
  60 ;;      Gael Marziou <gael@gnlab030.grenoble.hp.com>
  61 ;;      Keith Sheffield <sheff@edcsgw2.cr.usgs.gov>
  62 ;;      Jan Djarv <jan.djarv@sa.erisoft.se>
  63 ;;      Lars Lindberg <qhslali@aom.ericsson.se>
  64 ;;      Alf-Ivar Holm <alfh@ifi.uio.no>
  65 ;; for valuable feedback, code and bug reports.
  66
  67 ;;; Code:
  68
  69
  70 ;;;----------------------------------------------------------------------------
  71 ;;; user-configurable variables
  72
  73 (defgroup hideshow nil
  74   "Minor mode for hiding and showing program and comment blocks."
  75   :group 'languages)
  76
  77 ;;;#autoload
  78 (defcustom hs-hide-comments-when-hiding-all t
  79   "Hide the comments too when you do an `hs-hide-all'."
  80   :type 'boolean
  81   :group 'hideshow)
  82
  83 ;;;#autoload
  84 (defcustom hs-show-hidden-short-form t
  85   "Leave only the first line visible in a hidden block.
  86 If t only the first line is visible when a block is in the hidden state,
  87 else both the first line and the last line are showed. Also if t and
  88 `hs-adjust-block-beginning' is set, it is used also.
  89
  90 An example of how this works: (in c-mode)
  91 original:
  92
  93 /* My function main
  94    some more stuff about main
  95 */
  96 int
  97 main(void)
  98 {
  99   int x=0;
 100   return 0;
 101 }
 102
 103
 104 hidden and hs-show-hidden-short-form is nil
 105 /* My function main...
 106 */
 107 int
 108 main(void)
 109 {...
 110 }
 111
 112 hidden and hs-show-hidden-short-form is t
 113 /* My function main...
 114 int
 115 main(void)...
 116
 117 For latest you have to be on the line containing the ellipsis when
 118 you do `hs-show-block'."
 119   :type 'boolean
 120   :group 'hideshow)
 121
 122 (defcustom hs-minor-mode-hook 'hs-hide-initial-comment-block
 123   "Hook called when `hs-minor-mode' is installed.
 124 A good value for this would be `hs-hide-initial-comment-block' to
 125 hide all the comments at the beginning of the file."
 126   :type 'integer
 127   :group 'hideshow)
 128
 129 (defvar hs-unbalance-handler-method 'top-level
 130   "*Symbol representing how \"unbalanced parentheses\" should be handled.
 131 This error is usually signaled by `hs-show-block'.  One of four values:
 132 `top-level', `next-line', `signal' or `ignore'.  Default is `top-level'.
 133
 134 - `top-level' -- Show top-level block containing the currently troublesome
 135                  block.
 136 - `next-line' -- Use the fact that, for an already hidden block, its end
 137                  will be on the next line.  Attempt to show this block.
 138 - `signal' -- Pass the error through, stopping execution.
 139 - `ignore' -- Ignore the error, continuing execution.
 140
 141 Values other than these four will be interpreted as `signal'.")
 142
 143 ;;;#autoload
 144 (defvar hs-special-modes-alist
 145   '((c-mode "{" "}" nil nil hs-c-like-adjust-block-beginning)
 146     (c++-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning)
 147     (java-mode   "\\(\\(\\([ \t]*\\(\\(public\\|private\\|protected\\|abstract\\|static\\|\\final\\)[ \t\n]+\\)+\\(synchronized[ \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))
 148 ; I tested the java regexp using the following:
 149 ;(defvar hsj-public)
 150 ;(defvar hsj-syncronised)
 151 ;(defvar hsj-type)
 152 ;(defvar hsj-fname)
 153 ;(defvar hsj-par)
 154 ;(defvar hsj-throws)
 155 ;(defvar hsj-static)
 156
 157 ;(setq hsj-public "[ \t]*\\(\\(public\\|private\\|protected\\|abstract\\|static\\|\\final\\)[ \t\n]+\\)+")
 158 ;(setq hsj-syncronised "\\(synchronized[ \t\n]*\\)?")
 159 ;(setq hsj-type "[a-zA-Z0-9_:]+[ \t\n]*\\(\\[[ \t\n]*\\][ \t\n]*\\)?")
 160 ;(setq hsj-fname "\\([a-zA-Z0-9_:]+[ \t\n]*\\)")
 161 ;(setq hsj-par "([^)]*)")
 162 ;(setq hsj-throws "\\([ \n\t]+throws[ \t\n][^{]+\\)?")
 163
 164 ;(setq hsj-static "[ \t]*static[^{]*")
 165
 166
 167 ;(setq hs-block-start-regexp (concat
 168 ;                            "\\("
 169 ;                                "\\("
 170 ;                                     "\\("
 171 ;                                        hsj-public
 172 ;                                        hsj-syncronised
 173 ;                                        hsj-type
 174 ;                                        hsj-fname
 175 ;                                        hsj-par
 176 ;                                        hsj-throws
 177 ;                                     "\\)"
 178 ;                                     "\\|"
 179 ;                                     "\\("
 180 ;                                        hsj-static
 181 ;                                     "\\)"
 182 ;                                "\\)"
 183 ;                                   "[ \t\n]*{"
 184 ;                             "\\)"
 185 ;                                   ))
 186
 187   "*Alist for initializing the hideshow variables for different modes.
 188 It has the form
 189 (MODE START-RE END-RE COMMENT-START-RE FORWARD-SEXP-FUNC ADJUST-BEG-FUNC).
 190 If present, hideshow will use these values for the start and end regexps,
 191 respectively.  Since Algol-ish languages do not have single-character
 192 block delimiters, the function `forward-sexp' which is used by hideshow
 193 doesn't work.  In this case, if a similar function is provided, you can
 194 register it and have hideshow use it instead of `forward-sexp'.  To add
 195 more values, use
 196
 197 \t(pushnew '(new-mode st-re end-re function-name)
 198 \t      hs-special-modes-alist :test 'equal)
 199
 200 For example:
 201
 202 \t(pushnew '(simula-mode \"begin\" \"end\" \"!\" simula-next-statement)
 203 \t      hs-special-modes-alist :test 'equal)
 204
 205 See the documentation for `hs-adjust-block-beginning' to see what
 206 is the use of ADJUST-BEG-FUNC.
 207
 208 If any of those is left nil, hideshow will try to guess some values, see
 209 `hs-grok-mode-type' for this.
 210
 211 Note that the regexps should not contain leading or trailing whitespace.")
 212
 213 (defvar hs-hide-hook nil
 214   "*Hooks called at the end of `hs-hide-all' and `hs-hide-block'.")
 215
 216 (defvar hs-show-hook nil
 217   "*Hooks called at the end of commands to show text.
 218 These commands include `hs-show-all', `hs-show-block' and `hs-show-region'.")
 219
 220 (defvar hs-minor-mode-prefix "\C-c"
 221   "*Prefix key to use for hideshow commands in hideshow minor mode.")
 222
 223 ;;;----------------------------------------------------------------------------
 224 ;;; internal variables
 225
 226 (defvar hs-minor-mode nil
 227   "Non-nil if using hideshow mode as a minor mode of some other mode.
 228 Use the command `hs-minor-mode' to toggle this variable.")
 229
 230 (defvar hs-minor-mode-map nil
 231   "Mode map for hideshow minor mode.")
 232
 233 ;(defvar hs-menu-bar nil
 234 ;  "Menu bar for hideshow minor mode (Xemacs only).")
 235
 236 (defvar hs-c-start-regexp nil
 237   "Regexp for beginning of comments.
 238 Differs from mode-specific comment regexps in that
 239 surrounding whitespace is stripped.")
 240
 241 (defvar hs-block-start-regexp nil
 242   "Regexp for beginning of block.")
 243
 244 (defvar hs-block-end-regexp nil
 245   "Regexp for end of block.")
 246
 247 (defvar hs-forward-sexp-func 'forward-sexp
 248   "Function used to do a forward-sexp.
 249 Should change for Algol-ish modes.  For single-character block
 250 delimiters -- ie, the syntax table regexp for the character is
 251 either `(' or `)' -- `hs-forward-sexp-func' would just be `forward-sexp'.
 252 For other modes such as simula, a more specialized function
 253 is necessary.")
 254
 255 (defvar hs-adjust-block-beginning nil
 256   "Function used to tweak the block beginning.
 257 It has effect only if `hs-show-hidden-short-form' is t. The block it
 258 is hidden from the point returned by this function, as opposed to
 259 hiding it from the point returned when searching
 260 `hs-block-start-regexp'.  In c-like modes, if we wish to also hide the
 261 curly braces (if you think they occupy too much space on the screen),
 262 this function should return the starting point (at the end of line) of
 263 the hidden region.
 264
 265 It is called with a single argument ARG which is the the position in
 266 buffer after the block beginning.
 267
 268 It should return the position from where we should start hiding.
 269
 270 It should not move the point.
 271
 272 See `hs-c-like-adjust-block-beginning' for an example of using this.")
 273
 274 ;(defvar hs-emacs-type 'fsf
 275 ;  "Used to support both Emacs and Xemacs.")
 276
 277 ;(eval-when-compile
 278 ;  (if (string-match "xemacs\\|lucid" emacs-version)
 279 ;      (progn
 280 ;       (defvar current-menubar nil "")
 281 ;       (defun set-buffer-menubar (arg1))
 282 ;       (defun add-menu (arg1 arg2 arg3)))))
 283
 284 ;;;----------------------------------------------------------------------------
 285 ;;; support funcs
 286
 287 ;; snarfed from outline.el;
 288 (defun hs-flag-region (from to flag)
 289   "Hides or shows lines from FROM to TO, according to FLAG.
 290 If FLAG is nil then text is shown, while if FLAG is t the text is hidden."
 291     (save-excursion
 292       (goto-char from)
 293       (end-of-line)
 294       (hs-discard-overlays (point) to 'invisible 'hs)
 295       (if flag
 296           (let ((overlay (make-overlay (point) to)))
 297             ;; Make overlay hidden and intangible.
 298             (overlay-put overlay 'invisible 'hs)
 299             (overlay-put overlay 'hs t)
 300             (overlay-put overlay 'intangible t)))))
 301
 302 ;; Remove from the region BEG ... END all overlays
 303 ;; with a PROP property equal to VALUE.
 304 ;; Overlays with a PROP property different from VALUE are not touched.
 305 (defun hs-discard-overlays (beg end prop value)
 306   (if (< end beg)
 307       (setq beg (prog1 end (setq end beg))))
 308   (save-excursion
 309     (goto-char beg)
 310     (while (< (point) end)
 311       (let ((overlays (overlays-at (point))))
 312         (while overlays
 313           (let ((o (car overlays)))
 314             (if (eq (overlay-get o prop) value)
 315                     (delete-overlay o)))
 316           (setq overlays (cdr overlays))))
 317       (goto-char (next-overlay-change (point))))))
 318
 319 (defun hs-hide-block-at-point (&optional end comment-reg)
 320   "Hide block iff on block beginning, optional END means reposition at end.
 321 COMMENT-REG is a list of the form (BEGIN . END) and specifies the limits
 322 of the comment, or nil if the block is not a comment."
 323   (if comment-reg
 324       (progn
 325         ;; goto the end of line at the end of the comment
 326         (goto-char (nth 1 comment-reg))
 327         (unless hs-show-hidden-short-form (forward-line -1))
 328         (end-of-line)
 329         (hs-flag-region (car comment-reg)  (point) t)
 330         (goto-char (if end (nth 1 comment-reg) (car comment-reg))))
 331       (if (looking-at hs-block-start-regexp)
 332           (let* ((p ;; p is the point at the end of the block beginning
 333                   (if (and  hs-show-hidden-short-form
 334                             hs-adjust-block-beginning)
 335                       ;; we need to adjust the block beginning
 336                       (funcall hs-adjust-block-beginning (match-end 0))
 337                     (match-end 0)))
 338                  ;; q is the point at the end of the block
 339                  (q (progn (funcall hs-forward-sexp-func 1) (point))))
 340             ;; position the point so we can call `hs-flag-region'
 341             (unless hs-show-hidden-short-form (forward-line -1))
 342             (end-of-line)
 343             (if (and (< p (point)) (> (count-lines p q)
 344                                       (if hs-show-hidden-short-form 1 2)))
 345                 (hs-flag-region p (point) t))
 346             (goto-char (if end q p))))))
 347
 348 (defun hs-show-block-at-point (&optional end comment-reg)
 349   "Show block iff on block beginning.  Optional END means reposition at end.
 350 COMMENT-REG is a list of the forme (BEGIN . END) and specifies the limits
 351 of the comment. It should be nil when hiding a block."
 352   (if comment-reg
 353       (when (car comment-reg)
 354         (hs-flag-region (car comment-reg) (nth 1 comment-reg) nil)
 355         (goto-char (if end (nth 1 comment-reg) (car comment-reg))))
 356     (if (looking-at hs-block-start-regexp)
 357         (let* ((p (point))
 358                (q
 359                 (condition-case error   ; probably unbalanced paren
 360                     (progn
 361                       (funcall hs-forward-sexp-func 1)
 362                       (point))
 363                   (error
 364                    (cond
 365                     ((eq hs-unbalance-handler-method 'ignore)
 366                      ;; just ignore this block
 367                      (point))
 368                     ((eq hs-unbalance-handler-method 'top-level)
 369                      ;; try to get out of rat's nest and expose the whole func
 370                      (if (/= (current-column) 0) (beginning-of-defun))
 371                      (setq p (point))
 372                      (re-search-forward (concat "^" hs-block-start-regexp)
 373                                         (point-max) t 2)
 374                      (point))
 375                     ((eq hs-unbalance-handler-method 'next-line)
 376                      ;; assumption is that user knows what s/he's doing
 377                      (beginning-of-line) (setq p (point))
 378                      (end-of-line 2) (point))
 379                     (t
 380                      ;; pass error through -- this applies to `signal', too
 381                      (signal (car error) (cdr error))))))))
 382           (hs-flag-region p q nil)
 383           (goto-char (if end (1+ (point)) p))))))
 384
 385 (defun hs-safety-is-job-n ()
 386   "Warn `buffer-invisibility-spec' does not contain hs."
 387     (if (or buffer-invisibility-spec (assq 'hs buffer-invisibility-spec) )
 388         nil
 389       (message "Warning: `buffer-invisibility-spec' does not contain hs!!")
 390       (sit-for 2)))
 391
 392 (defun hs-hide-initial-comment-block ()
 393   (interactive)
 394   "Hides the first block of comments in a file.
 395 The best usage is in `hs-minor-mode-hook', it hides all the comments at the
 396 file beginning, so if you have huge RCS logs you won't see them!"
 397       (let ((p (point))
 398             c-reg)
 399         (goto-char (point-min))
 400         (skip-chars-forward " \t\n^L")
 401         (setq c-reg (hs-inside-comment-p))
 402         ;; see if we have enough comment lines to hide
 403         (if (and c-reg (> (count-lines (car c-reg) (nth 1 c-reg))
 404                           (if hs-show-hidden-short-form 1 2)))
 405             (hs-hide-block)
 406           (goto-char p))))
 407
 408 (defun hs-inside-comment-p ()
 409   "Returns non-nil if point is inside a comment, otherwise nil.
 410 Actually, returns a list containing the buffer position of the start
 411 and the end of the comment. A comment block can be hided only if on its
 412 starting line there are only white spaces preceding the actual comment
 413 beginning, if we are inside of a comment but this condition is not
 414 we return a list having a nil as its car and the end of comment position
 415 as cdr."
 416   (save-excursion
 417     ;; the idea is to look backwards for a comment start regexp, do a
 418     ;; forward comment, and see if we are inside, then extend extend
 419     ;; forward and backward as long as we have comments
 420     (let ((q (point)))
 421       (when (or (looking-at hs-c-start-regexp)
 422               (re-search-backward hs-c-start-regexp (point-min) t))
 423         (forward-comment (- (buffer-size)))
 424         (skip-chars-forward " \t\n\f")
 425         (let ((p (point))
 426               (not-hidable nil))
 427           (beginning-of-line)
 428           (unless (looking-at (concat "[ \t]*" hs-c-start-regexp))
 429             ;; we are in this situation: (example)
 430             ;; (defun bar ()
 431             ;;      (foo)
 432             ;;                ) ; comment
 433             ;;                 ^
 434             ;;   the point was here before doing (beginning-of-line)
 435             ;; here we should advance till the next comment which
 436             ;; eventually has only white spaces preceding it on the same
 437             ;; line
 438             (goto-char p)
 439             (forward-comment 1)
 440             (skip-chars-forward " \t\n\f")
 441             (setq p (point))
 442             (while (and (< (point) q)
 443                         (> (point) p)
 444                         (not (looking-at hs-c-start-regexp)))
 445               (setq p (point))  ;; use this to avoid an infinit cycle.
 446               (forward-comment 1)
 447               (skip-chars-forward " \t\n\f"))
 448             (if (or (not (looking-at hs-c-start-regexp))
 449                     (> (point) q))
 450                 ;; we cannot hide this comment block
 451                 (setq not-hidable t)))
 452           ;; goto the end of the comment
 453           (forward-comment (buffer-size))
 454           (skip-chars-backward " \t\n\f")
 455           (end-of-line)
 456           (if (>= (point) q)
 457               (list (if not-hidable nil p) (point))))))))
 458
 459 (defun hs-grok-mode-type ()
 460   "Setup variables for new buffers where applicable."
 461   (when (and (boundp 'comment-start)
 462              (boundp 'comment-end))
 463     (let ((lookup (assoc major-mode hs-special-modes-alist)))
 464       (setq hs-block-start-regexp (or (nth 1 lookup) "\\s\(")
 465             hs-block-end-regexp (or (nth 2 lookup) "\\s\)")
 466             hs-c-start-regexp (or (nth 3 lookup)
 467                                   (let ((c-start-regexp
 468                                          (regexp-quote comment-start)))
 469                                     (if (string-match " +$" c-start-regexp)
 470                                          (substring c-start-regexp 0 (1- (match-end 0)))
 471                                       c-start-regexp)))
 472             hs-forward-sexp-func (or (nth 4 lookup) 'forward-sexp)
 473             hs-adjust-block-beginning (nth 5 lookup)))))
 474
 475 (defun hs-find-block-beginning ()
 476   "Repositions point at block-start.
 477 Return point, or nil if top-level."
 478   (let (done
 479         (try-again t)
 480         (here (point))
 481         (both-regexps (concat "\\(" hs-block-start-regexp "\\)\\|\\("
 482                               hs-block-end-regexp "\\)"))
 483         (buf-size (buffer-size)))
 484     (beginning-of-line)
 485     ;; A block beginning can span on multiple lines, if the point
 486     ;; is on one of those lines, trying a regexp search from
 487     ;; that point would fail to find the block beginning, so we look
 488     ;; backwards for the block beginning, or a block end.
 489     (while try-again
 490       (setq try-again nil)
 491       (if (and (re-search-backward both-regexps (point-min) t)
 492                (match-beginning 1)) ; found a block beginning
 493           (if (save-match-data (hs-inside-comment-p))
 494               ;;but it was inside a comment, so we have to look for
 495               ;;it again
 496               (setq try-again t)
 497             ;; that's what we were looking for
 498             (setq done (match-beginning 0)))
 499         ;; we found a block end, or we reached the beginning of the
 500         ;; buffer look to see if we were on a block beginning when we
 501         ;; started
 502         (if (and
 503              (re-search-forward hs-block-start-regexp (point-max) t)
 504              (or
 505               (and (>= here (match-beginning 0)) (< here (match-end 0)))
 506               (and hs-show-hidden-short-form hs-adjust-block-beginning
 507                    (save-match-data
 508                      (= 1 (count-lines
 509                            (funcall hs-adjust-block-beginning
 510                                     (match-end 0)) here))))))
 511               (setq done (match-beginning 0)))))
 512     (goto-char here)
 513     (while (and (not done)
 514                 ;; This had problems because the regexp can match something
 515                 ;; inside of a comment!
 516                 ;; Since inside a comment we can have incomplete sexps
 517                 ;; this would have signaled an error.
 518                 (or (forward-comment (- buf-size)) t); `or' is a hack to
 519                                                          ; make it return t
 520                 (re-search-backward both-regexps (point-min) t))
 521       (if (match-beginning 1)           ; start of start-regexp
 522           (setq done (match-beginning 0))
 523         (goto-char (match-end 0))       ; end of end-regexp
 524         (funcall hs-forward-sexp-func -1)))
 525     (goto-char (or done here))
 526     done))
 527
 528 (defmacro hs-life-goes-on (&rest body)
 529   "Executes optional BODY iff variable `hs-minor-mode' is non-nil."
 530   (list 'if 'hs-minor-mode (cons 'progn body)))
 531
 532 (defun hs-already-hidden-p ()
 533   "Return non-nil if point is in an already-hidden block, otherwise nil."
 534   (save-excursion
 535     (let ((c-reg (hs-inside-comment-p)))
 536       (if (and c-reg (nth 0 c-reg))
 537           ;; point is inside a comment, and that comment is hidable
 538           (goto-char (nth 0 c-reg))
 539         (if (and (not c-reg) (hs-find-block-beginning)
 540                  (looking-at hs-block-start-regexp))
 541             ;; point is inside a block
 542             (goto-char (match-end 0)))))
 543     (end-of-line)
 544     (let ((overlays (overlays-at (point)))
 545           (found nil))
 546       (while (and (not found) (overlayp (car overlays)))
 547            (setq found (overlay-get (car overlays) 'hs)
 548                  overlays (cdr overlays)))
 549       found)))
 550
 551 (defun java-hs-forward-sexp (arg)
 552   "Function used by `hs-minor-mode' for `forward-sexp' in Java mode."
 553   (if (< arg 0)
 554       (backward-sexp 1)
 555     (if (looking-at hs-block-start-regexp)
 556         (progn
 557           (goto-char (match-end 0))
 558           (forward-char -1)
 559           (forward-sexp 1))
 560       (forward-sexp 1))))
 561
 562 (defun hs-c-like-adjust-block-beginning (arg)
 563   "Function to be assigned to `hs-adjust-block-beginning' for C like modes.
 564 Arg is a position in buffer just after {. This goes back to the end of
 565 the function header. The purpose is to save some space on the screen
 566 when displaying hidden blocks."
 567   (save-excursion
 568     (goto-char arg)
 569     (forward-char -1)
 570     (forward-comment (- (buffer-size)))
 571     (point)))
 572
 573 ;;;----------------------------------------------------------------------------
 574 ;;; commands
 575
 576 ;;;###autoload
 577 (defun hs-hide-all ()
 578   "Hides all top-level blocks, displaying only first and last lines.
 579 It moves point to the beginning of the line, and it runs the normal hook
 580 `hs-hide-hook'.  See documentation for `run-hooks'.
 581 If `hs-hide-comments-when-hiding-all' is t also hides the comments."
 582   (interactive)
 583   (hs-life-goes-on
 584    (message "Hiding all blocks ...")
 585    (save-excursion
 586      (hs-flag-region (point-min) (point-max) nil) ; eliminate weirdness
 587      (goto-char (point-min))
 588      (if hs-hide-comments-when-hiding-all
 589          (let (c-reg
 590                (count 0)
 591                (block-and-comment-re  ;; this should match
 592                 (concat "\\(^"        ;; the block beginning and comment start
 593                         hs-block-start-regexp
 594                         "\\)\\|\\(" hs-c-start-regexp "\\)")))
 595            (while (re-search-forward block-and-comment-re (point-max) t)
 596              (if (match-beginning 1) ;; we have found a block beginning
 597                  (progn
 598                    (goto-char (match-beginning 1))
 599                    (hs-hide-block-at-point t)
 600                    (message "Hiding ... %d" (setq count (1+ count))))
 601                ;;found a comment
 602                (setq c-reg (hs-inside-comment-p))
 603                (if (and c-reg (car c-reg))
 604                    (if (> (count-lines (car c-reg) (nth 1 c-reg))
 605                           (if hs-show-hidden-short-form 1 2))
 606                        (progn
 607                          (hs-hide-block-at-point t c-reg)
 608                          (message "Hiding ... %d" (setq count (1+ count))))
 609                      (goto-char (nth 1 c-reg)))))))
 610        (let ((count 0)
 611              (top-level-re (concat "^" hs-block-start-regexp))
 612              (buf-size (buffer-size)))
 613          (while
 614              (progn
 615                (forward-comment buf-size)
 616                (re-search-forward top-level-re (point-max) t))
 617            (goto-char (match-beginning 0))
 618            (hs-hide-block-at-point t)
 619            (message "Hiding ... %d" (setq count (1+ count))))))
 620    (hs-safety-is-job-n))
 621    (beginning-of-line)
 622    (message "Hiding all blocks ... done")
 623    (run-hooks 'hs-hide-hook)))
 624
 625 (defun hs-show-all ()
 626   "Shows all top-level blocks.
 627 This does not change point; it runs the normal hook `hs-show-hook'.
 628 See documentation for `run-hooks'."
 629   (interactive)
 630   (hs-life-goes-on
 631    (message "Showing all blocks ...")
 632    (hs-flag-region (point-min) (point-max) nil)
 633    (message "Showing all blocks ... done")
 634    (run-hooks 'hs-show-hook)))
 635
 636 (defun hs-hide-block (&optional end)
 637   "Selects a block and hides it.
 638 With prefix arg, reposition at end. Block is defined as a sexp for
 639 lispish modes, mode-specific otherwise. Comments are blocks, too.
 640 Upon completion, point is at repositioned and the normal hook
 641 `hs-hide-hook' is run.  See documentation for `run-hooks'."
 642   (interactive "P")
 643   (hs-life-goes-on
 644    (let ((c-reg (hs-inside-comment-p)))
 645      (cond
 646       ((and c-reg (or (null (nth 0 c-reg))
 647                       (<= (count-lines (car c-reg) (nth 1 c-reg))
 648                           (if hs-show-hidden-short-form 1 2))))
 649            (message "Not enough comment lines to hide!"))
 650       ((or c-reg (looking-at hs-block-start-regexp)
 651                (hs-find-block-beginning))
 652        (hs-hide-block-at-point end c-reg)
 653        (hs-safety-is-job-n)
 654        (run-hooks 'hs-hide-hook))))))
 655
 656 (defun hs-show-block (&optional end)
 657   "Selects a block and shows it.
 658 With prefix arg, reposition at end. Upon completion, point is
 659 repositioned and the normal hook `hs-show-hook' is run.
 660 See documentation for `hs-hide-block' and `run-hooks'."
 661   (interactive "P")
 662   (hs-life-goes-on
 663    (let ((c-reg (hs-inside-comment-p)))
 664      (if (or c-reg
 665              (looking-at hs-block-start-regexp)
 666              (hs-find-block-beginning))
 667            (progn
 668              (hs-show-block-at-point end c-reg)
 669              (hs-safety-is-job-n)
 670              (run-hooks 'hs-show-hook))))))
 671
 672 (defun hs-show-region (beg end)
 673   "Shows all lines from BEG to END, without doing any block analysis.
 674 Note:`hs-show-region' is intended for use when `hs-show-block' signals
 675 `unbalanced parentheses' and so is an emergency measure only.  You may
 676 become very confused if you use this command indiscriminately."
 677   (interactive "r")
 678   (hs-life-goes-on
 679    (hs-flag-region beg end nil)
 680    (hs-safety-is-job-n)
 681    (run-hooks 'hs-show-hook)))
 682
 683 ;;;###autoload
 684 (defun hs-mouse-toggle-hiding (e)
 685   "Toggles hiding/showing of a block.
 686 Should be bound to a mouse key."
 687   (interactive "@e")
 688   (mouse-set-point e)
 689   (if (hs-already-hidden-p)
 690       (hs-show-block)
 691     (hs-hide-block)))
 692
 693 ;;;###autoload
 694 (defun hs-minor-mode (&optional arg)
 695   "Toggle hideshow minor mode.
 696 With ARG, turn hideshow minor mode on if ARG is positive, off otherwise.
 697 When hideshow minor mode is on, the menu bar is augmented with hideshow
 698 commands and the hideshow commands are enabled.
 699 The value '(hs . t) is added to `buffer-invisibility-spec'.
 700 Last, the normal hook `hs-minor-mode-hook' is run; see the doc
 701 for `run-hooks'.
 702
 703 The main commands are: `hs-hide-all', `hs-show-all', `hs-hide-block'
 704 and `hs-show-block'.
 705 Also see the documentation for the variable `hs-show-hidden-short-form'.
 706
 707 Turning hideshow minor mode off reverts the menu bar and the
 708 variables to default values and disables the hideshow commands.
 709
 710 Key bindings:
 711 \\{hs-minor-mode-map}"
 712
 713   (interactive "P")
 714   (setq hs-minor-mode
 715         (if (null arg)
 716             (not hs-minor-mode)
 717           (> (prefix-numeric-value arg) 0)))
 718   (if hs-minor-mode
 719       (progn
 720 ;       (if (eq hs-emacs-type 'lucid)
 721 ;           (progn
 722 ;             (set-buffer-menubar (copy-sequence current-menubar))
 723 ;             (add-menu nil (car hs-menu-bar) (cdr hs-menu-bar))))
 724         (make-variable-buffer-local 'line-move-ignore-invisible)
 725         (setq  line-move-ignore-invisible t)
 726         (add-to-invisibility-spec '(hs . t)) ;;hs invisible
 727         (hs-grok-mode-type)
 728         (run-hooks 'hs-minor-mode-hook))
 729 ;    (if (eq hs-emacs-type 'lucid)
 730 ;       (set-buffer-menubar (delete hs-menu-bar current-menubar)))
 731     (remove-from-invisibility-spec '(hs . t))))
 732
 733
 734 ;;;----------------------------------------------------------------------------
 735 ;;; load-time setup routines
 736
 737 ;; which emacs being used?
 738 ;(setq hs-emacs-type
 739 ;      (if (string-match "xemacs\\|lucid" emacs-version)
 740 ;         'lucid
 741 ;       'fsf))
 742
 743 ;; keymaps and menus
 744 (if hs-minor-mode-map
 745     nil
 746   (setq hs-minor-mode-map (make-sparse-keymap))
 747   ;; I beleive there is nothing bound on this keys
 748   (define-key hs-minor-mode-map "\C-ch" 'hs-hide-block)
 749   (define-key hs-minor-mode-map "\C-cs" 'hs-show-block)
 750   (define-key hs-minor-mode-map "\C-cH" 'hs-hide-all)
 751   (define-key hs-minor-mode-map "\C-cS" 'hs-show-all)
 752   (define-key hs-minor-mode-map "\C-cR" 'hs-show-region)
 753
 754   (define-key hs-minor-mode-map [S-mouse-2] 'hs-mouse-toggle-hiding)
 755
 756   ;; should we use easymenu here?
 757   (define-key hs-minor-mode-map [menu-bar Hide/Show]
 758     (cons "Hide/Show" (make-sparse-keymap "Hide/Show")))
 759   (define-key hs-minor-mode-map [menu-bar Hide/Show  hs-show-region]
 760     '("Show Region" . hs-show-region))
 761   (define-key hs-minor-mode-map [menu-bar Hide/Show hs-show-all]
 762     '("Show All" . hs-show-all))
 763   (define-key hs-minor-mode-map [menu-bar Hide/Show hs-hide-all]
 764     '("Hide All" . hs-hide-all))
 765   (define-key hs-minor-mode-map [menu-bar Hide/Show hs-show-block]
 766     '("Show Block" . hs-show-block))
 767   (define-key hs-minor-mode-map [menu-bar Hide/Show hs-hide-block]
 768     '("Hide Block" . hs-hide-block)))
 769
 770 ;; some housekeeping
 771 (or (assq 'hs-minor-mode minor-mode-map-alist)
 772     (setq minor-mode-map-alist
 773           (cons (cons 'hs-minor-mode hs-minor-mode-map)
 774                 minor-mode-map-alist)))
 775 (or (assq 'hs-minor-mode minor-mode-alist)
 776     (setq minor-mode-alist (append minor-mode-alist
 777                                    (list '(hs-minor-mode " hs")))))
 778
 779 ;; make some variables buffer-local
 780 (make-variable-buffer-local 'hs-minor-mode)
 781 (make-variable-buffer-local 'hs-c-start-regexp)
 782 (make-variable-buffer-local 'hs-block-start-regexp)
 783 (make-variable-buffer-local 'hs-block-end-regexp)
 784 (make-variable-buffer-local 'hs-forward-sexp-func)
 785 (make-variable-buffer-local 'hs-adjust-block-beginning)
 786 (put 'hs-minor-mode 'permanent-local t)
 787 (put 'hs-c-start-regexp 'permanent-local t)
 788 (put 'hs-block-start-regexp 'permanent-local t)
 789 (put 'hs-block-end-regexp 'permanent-local t)
 790 (put 'hs-forward-sexp-func 'permanent-local t)
 791 (put 'hs-adjust-block-beginning 'permanent-local t)
 792
 793
 794 ;;;----------------------------------------------------------------------------
 795 ;;; that's it
 796
 797 (provide 'hideshow)
 798
 799 ;;; hideshow.el ends here