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
   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 (defvar hs-unbalance-handler-method 'top-level
  74   "*Symbol representing how \"unbalanced parentheses\" should be handled.
  75 This error is usually signaled by `hs-show-block'.  One of four values:
  76 `top-level', `next-line', `signal' or `ignore'.  Default is `top-level'.
  77
  78 - `top-level' -- Show top-level block containing the currently troublesome
  79                  block.
  80 - `next-line' -- Use the fact that, for an already hidden block, its end
  81                  will be on the next line.  Attempt to show this block.
  82 - `signal' -- Pass the error through, stopping execution.
  83 - `ignore' -- Ignore the error, continuing execution.
  84
  85 Values other than these four will be interpreted as `signal'.")
  86
  87 ;;;#autoload
  88 (defvar hs-special-modes-alist
  89   '((c-mode "{" "}")
  90     (c++-mode "{" "}")
  91     (java-mode "\\(\\(public\\|private\\|protected\\|static\\|\\s-\\)+\\([a-zA-Z0-9_:]+[ \t]+\\)\\([a-zA-Z0-9_:]+\\)[ \t]*([^)]*)[ \t\n]*\\([ \t\n]throws[ \t]+[^{]+\\)*[ \t]*\\){" "}" java-hs-forward-sexp))
  92   "*Alist of the form (MODE START-RE END-RE FORWARD-SEXP-FUNC).
  93 If present, hideshow will use these values for the start and end regexps,
  94 respectively.  Since Algol-ish languages do not have single-character
  95 block delimiters, the function `forward-sexp' which is used by hideshow
  96 doesn't work.  In this case, if a similar function is provided, you can
  97 register it and have hideshow use it instead of `forward-sexp'.  To add
  98 more values, use
  99
 100 \t(pushnew '(new-mode st-re end-re function-name)
 101 \t      hs-special-modes-alist :test 'equal)
 102
 103 For example:
 104
 105 \t(pushnew '(simula-mode \"begin\" \"end\" simula-next-statement)
 106 \t      hs-special-modes-alist :test 'equal)
 107
 108 Note that the regexps should not contain leading or trailing whitespace.")
 109
 110 (defvar hs-minor-mode-hook 'hs-hide-initial-comment-block
 111   "Hook called when `hs-minor-mode' is installed.
 112 A good value for this would be `hs-hide-initial-comment-block' to
 113 hide all the comments at the beginning of the file.")
 114
 115 (defvar hs-hide-hook nil
 116   "*Hooks called at the end of `hs-hide-all' and `hs-hide-block'.")
 117
 118 (defvar hs-show-hook nil
 119   "*Hooks called at the end of commands to show text.
 120 These commands include `hs-show-all', `hs-show-block' and `hs-show-region'.")
 121
 122 (defvar hs-minor-mode-prefix "\C-c"
 123   "*Prefix key to use for hideshow commands in hideshow minor mode.")
 124
 125
 126 ;;;----------------------------------------------------------------------------
 127 ;;; internal variables
 128
 129 (defvar hs-minor-mode nil
 130   "Non-nil if using hideshow mode as a minor mode of some other mode.
 131 Use the command `hs-minor-mode' to toggle this variable.")
 132
 133 (defvar hs-minor-mode-map nil
 134   "Mode map for hideshow minor mode.")
 135
 136 (defvar hs-menu-bar nil
 137   "Menu bar for hideshow minor mode (Xemacs only).")
 138
 139 (defvar hs-c-start-regexp nil
 140   "Regexp for beginning of comments.
 141 Differs from mode-specific comment regexps in that
 142 surrounding whitespace is stripped.")
 143
 144 (defvar hs-c-end-regexp nil
 145   "Regexp for end of comments.
 146 See `hs-c-start-regexp'.")
 147
 148 (defvar hs-block-start-regexp nil
 149   "Regexp for beginning of block.")
 150
 151 (defvar hs-block-end-regexp nil
 152   "Regexp for end of block.")
 153
 154 (defvar hs-forward-sexp-func 'forward-sexp
 155   "Function used to do a forward-sexp.
 156 Should change for Algol-ish modes.  For single-character block
 157 delimiters -- ie, the syntax table regexp for the character is
 158 either `(' or `)' -- `hs-forward-sexp-func' would just be `forward-sexp'.
 159 For other modes such as simula, a more specialized function
 160 is necessary.")
 161
 162 (defvar hs-hide-comments-when-hiding-all t
 163   "Hide the comments too when you do an `hs-hide-all'." )
 164
 165 ;(defvar hs-emacs-type 'fsf
 166 ;  "Used to support both Emacs and Xemacs.")
 167
 168 ;(eval-when-compile
 169 ;  (if (string-match "xemacs\\|lucid" emacs-version)
 170 ;      (progn
 171 ;       (defvar current-menubar nil "")
 172 ;       (defun set-buffer-menubar (arg1))
 173 ;       (defun add-menu (arg1 arg2 arg3)))))
 174
 175 ;;;----------------------------------------------------------------------------
 176 ;;; support funcs
 177
 178 ;; snarfed from noutline.el;
 179 (defun hs-flag-region (from to flag)
 180   "Hides or shows lines from FROM to TO, according to FLAG.
 181 If FLAG is nil then text is shown, while if FLAG is t the text is hidden."
 182     (save-excursion
 183       (goto-char from)
 184       (end-of-line)
 185       (hs-discard-overlays (point) to 'invisible 'hs)
 186       (if flag
 187           (let ((overlay (make-overlay (point) to)))
 188             ;; Make overlay hidden and intangible.
 189             (overlay-put overlay 'invisible 'hs)
 190             (overlay-put overlay 'hs t)
 191             (overlay-put overlay 'intangible t)))))
 192
 193 ;; Remove from the region BEG ... END all overlays
 194 ;; with a PROP property equal to VALUE.
 195 ;; Overlays with a PROP property different from VALUE are not touched.
 196 (defun hs-discard-overlays (beg end prop value)
 197   (if (< end beg)
 198       (setq beg (prog1 end (setq end beg))))
 199   (save-excursion
 200     (goto-char beg)
 201     (while (< (point) end)
 202       (let ((overlays (overlays-at (point))))
 203         (while overlays
 204           (let ((o (car overlays)))
 205             (if (eq (overlay-get o prop) value)
 206                 (if (or
 207                      (and (> (overlay-end o) beg) (< (overlay-end o) end))
 208                      (and (< (overlay-start o) beg) (< (overlay-start o) end)))
 209                     (delete-overlay o))))
 210           (setq overlays (cdr overlays))))
 211       (goto-char (next-overlay-change (point))))))
 212
 213 (defun hs-hide-block-at-point (&optional end comment c-reg)
 214   "Hide block iff on block beginning, optional END means reposition at end.
 215 COMMENT true means that it should hide a comment block, C-REG is a list
 216 of the forme (BEGIN . END) and specifies the limits of the comment."
 217   (if comment
 218       (let ((reg (if c-reg  c-reg (hs-inside-comment-p))))
 219         (goto-char (nth 1 reg))
 220         (forward-line -1)
 221         (end-of-line)
 222         (hs-flag-region (car reg)  (point) t)
 223         (goto-char (if end (nth 1 reg) (car reg)))
 224         )
 225       (if (looking-at hs-block-start-regexp)
 226           (let* ((p (point))
 227                  (q (progn (funcall hs-forward-sexp-func 1) (point))))
 228             (forward-line -1) (end-of-line)
 229             (if (and (< p (point)) (> (count-lines p q) 1))
 230             (hs-flag-region p (point) t))
 231         (goto-char (if end q p))))))
 232
 233 (defun hs-show-block-at-point (&optional end)
 234   "Show block iff on block beginning.  Optional END means reposition at end."
 235   (if (looking-at hs-block-start-regexp)
 236       (let* ((p (point))
 237              (q
 238               (condition-case error     ; probably unbalanced paren
 239                   (progn
 240                     (funcall hs-forward-sexp-func 1)
 241                     (point))
 242                 (error
 243                  (cond
 244                   ((eq hs-unbalance-handler-method 'ignore)
 245                    ;; just ignore this block
 246                    (point))
 247                   ((eq hs-unbalance-handler-method 'top-level)
 248                    ;; try to get out of rat's nest and expose the whole func
 249                    (if (/= (current-column) 0) (beginning-of-defun))
 250                    (setq p (point))
 251                    (re-search-forward (concat "^" hs-block-start-regexp)
 252                                       (point-max) t 2)
 253                    (point))
 254                   ((eq hs-unbalance-handler-method 'next-line)
 255                    ;; assumption is that user knows what s/he's doing
 256                    (beginning-of-line) (setq p (point))
 257                    (end-of-line 2) (point))
 258                   (t
 259                    ;; pass error through -- this applies to `signal', too
 260                    (signal (car error) (cdr error))))))))
 261         (hs-flag-region p q nil)
 262         (goto-char (if end (1+ (point)) p)))))
 263
 264 (defun hs-safety-is-job-n ()
 265   "Warn `buffer-invisibility-spec' does not contain hs."
 266     (if (or buffer-invisibility-spec (assq hs buffer-invisibility-spec) )
 267         nil
 268       (message "Warning: `buffer-invisibility-spec' does not contain hs!!")
 269       (sit-for 2)))
 270
 271 (defun hs-hide-initial-comment-block ()
 272   (interactive)
 273   "Hides the first block of comments in a file.
 274 The best usage is in `hs-minor-mode-hook', it hides all the comments at the
 275 file beginning, so if you have huge RCS logs you won't see them!"
 276       (let ((p (point))
 277             c-reg)
 278         (goto-char (point-min))
 279         (skip-chars-forward " \t\n")
 280         (setq c-reg (hs-inside-comment-p))
 281         (if (and c-reg (> (count-lines (car c-reg) (nth 1 c-reg)) 2))
 282             (hs-hide-block)
 283           (goto-char p))))
 284
 285 (defun hs-inside-single-line-comment-p ()
 286   "Look to see if we are on a single line comment."
 287   (save-excursion
 288     (beginning-of-line)
 289     (looking-at (concat "^[ \t]*" hs-c-start-regexp))))
 290
 291 (defun hs-inside-comment-p ()
 292   "Returns non-nil if point is inside a comment, otherwise nil.
 293 Actually, returns a list containing the buffer position of the start
 294 and the end of the comment."
 295   (save-excursion
 296     (let ((p (point))
 297           q
 298           p-aux)
 299       (if (string= comment-end "")      ; single line
 300             (if (not (hs-inside-single-line-comment-p))
 301                 nil
 302               ;;find-beginning-of-the-chained-single-line-comments
 303               (beginning-of-line)
 304               (forward-comment (- (buffer-size)))
 305               (skip-chars-forward " \t\n")
 306               (beginning-of-line)
 307               (setq q (point))
 308               (goto-char p)
 309               ;;find-end-of-the-chained-single-line-comments
 310               (forward-comment (buffer-size))
 311               (skip-chars-backward " \t\n")
 312               (list q   (point)))
 313         (re-search-forward hs-c-end-regexp (point-max) 1)
 314         (forward-comment (buffer-size))
 315         (skip-chars-backward " \t\n")
 316         (end-of-line)
 317         (setq q (point))
 318         (forward-comment (- 0 (buffer-size)))
 319         (re-search-forward hs-c-start-regexp (point-max) 1)
 320         (setq p-aux (- (point) (length comment-start)))
 321         (if (and (>= p-aux 0) (< p-aux p))
 322             (list (match-beginning 0) q))))))
 323
 324 (defun hs-grok-mode-type ()
 325   "Setup variables for new buffers where applicable."
 326   (if (and (boundp 'comment-start)
 327            (boundp 'comment-end))
 328       (progn
 329         (setq hs-c-start-regexp (regexp-quote comment-start))
 330         (if (string-match " +$" hs-c-start-regexp)
 331             (setq hs-c-start-regexp
 332                   (substring hs-c-start-regexp 0 (1- (match-end 0)))))
 333         (setq hs-c-end-regexp (if (string= "" comment-end) "\n"
 334                                 (regexp-quote comment-end)))
 335         (if (string-match "^ +" hs-c-end-regexp)
 336             (setq hs-c-end-regexp
 337                   (substring hs-c-end-regexp (match-end 0))))
 338         (let ((lookup (assoc major-mode hs-special-modes-alist)))
 339           (setq hs-block-start-regexp (or (nth 1 lookup) "\\s\(")
 340                 hs-block-end-regexp (or (nth 2 lookup) "\\s\)")
 341                 hs-forward-sexp-func (or (nth 3 lookup) 'forward-sexp))))))
 342
 343 (defun hs-find-block-beginning ()
 344   "Repositions point at block-start.
 345 Return point, or nil if top-level."
 346   (let (done
 347         (here (point))
 348         (both-regexps (concat "\\(" hs-block-start-regexp "\\)\\|\\("
 349                               hs-block-end-regexp "\\)")))
 350     (while (and (not done)
 351                 (re-search-backward both-regexps (point-min) t))
 352       (if (match-beginning 1)           ; start of start-regexp
 353           (setq done (match-beginning 1))
 354         (goto-char (match-end 2))       ; end of end-regexp
 355         (funcall hs-forward-sexp-func -1)))
 356     (goto-char (or done here))
 357     done))
 358
 359 (defmacro hs-life-goes-on (&rest body)
 360   "Executes optional BODY iff variable `hs-minor-mode' is non-nil."
 361   (list 'if 'hs-minor-mode (cons 'progn body)))
 362
 363 (defun hs-already-hidden-p ()
 364   "Return non-nil if point is in an already-hidden block otherwise nil."
 365   (save-excursion
 366     (end-of-line)
 367     (let ((overlays (overlays-at (point)))
 368           (found nil))
 369       (while (and (not found) (overlayp (car overlays)))
 370            (setq found (overlay-get (car overlays) 'hs)
 371                  overlays (cdr overlays)))
 372       found)))
 373
 374 (defun java-hs-forward-sexp (arg)
 375   "Function used by `hs-minor-mode' for `forward-sexp' in Java mode."
 376   (if (< arg 0)
 377       (backward-sexp 1)
 378     (if (looking-at hs-block-start-regexp)
 379         (progn
 380           (goto-char (match-end 0))
 381           (forward-char -1)
 382           (forward-sexp 1))
 383       (forward-sexp 1))))
 384
 385 ;;;----------------------------------------------------------------------------
 386 ;;; commands
 387
 388 ;;;###autoload
 389 (defun hs-hide-all ()
 390   "Hides all top-level blocks, displaying only first and last lines.
 391 It moves point to the beginning of the line, and it runs the normal hook
 392 `hs-hide-hook'.  See documentation for `run-hooks'.
 393 If `hs-hide-comments-when-hiding-all' is t also hides the comments."
 394   (interactive)
 395   (hs-life-goes-on
 396    (message "Hiding all blocks ...")
 397    (save-excursion
 398      (hs-flag-region (point-min) (point-max) nil) ; eliminate weirdness
 399      (goto-char (point-min))
 400      (if hs-hide-comments-when-hiding-all
 401          (let ((count 0)
 402                (block-and-comment-re  ;; this should match
 403                 (concat "\\(^"        ;; the block beginning and comment start
 404                         hs-block-start-regexp
 405                         "\\)\\|\\(" hs-c-start-regexp "\\)")))
 406            (while (re-search-forward block-and-comment-re (point-max) t)
 407              (if (match-beginning 1) ;; we have found a block beginning
 408                  (progn
 409                    (goto-char (match-beginning 1))
 410                    (hs-hide-block-at-point t)
 411                    (message "Hiding ... %d" (setq count (1+ count))))
 412                ;;found a comment
 413                (setq c-reg (hs-inside-comment-p))
 414                (if c-reg
 415                    (progn
 416                      (goto-char (nth 1 c-reg))
 417                      (if (> (count-lines (car c-reg) (nth 1 c-reg)) 2)
 418                          (progn
 419                            (hs-hide-block-at-point t t c-reg)
 420                            (message "Hiding ... %d"
 421                                     (setq count (1+ count))))))))))
 422        (let ((count 0)
 423              (top-level-re (concat "^" hs-block-start-regexp)))
 424          (while
 425              (progn
 426                (forward-comment (buffer-size))
 427                (re-search-forward top-level-re (point-max) t))
 428            (goto-char (match-beginning 0))
 429            (hs-hide-block-at-point t)
 430            (message "Hiding ... %d" (setq count (1+ count))))))
 431    (hs-safety-is-job-n))
 432    (beginning-of-line)
 433    (message "Hiding all blocks ... done")
 434    (run-hooks 'hs-hide-hook)))
 435
 436 (defun hs-show-all ()
 437   "Shows all top-level blocks.
 438 This does not change point; it runs the normal hook `hs-show-hook'.
 439 See documentation for `run-hooks'."
 440   (interactive)
 441   (hs-life-goes-on
 442    (message "Showing all blocks ...")
 443    (hs-flag-region (point-min) (point-max) nil)
 444    (message "Showing all blocks ... done")
 445    (run-hooks 'hs-show-hook)))
 446
 447 (defun hs-hide-block (&optional end)
 448   "Selects a block and hides it.
 449 With prefix arg, reposition at end.  Block is defined as a sexp for
 450 lispish modes, mode-specific otherwise.  Comments are blocks, too.
 451 Upon completion, point is at repositioned and the normal hook
 452 `hs-hide-hook' is run.  See documentation for `run-hooks'."
 453   (interactive "P")
 454   (hs-life-goes-on
 455    (let ((c-reg (hs-inside-comment-p)))
 456      (if c-reg
 457          (cond
 458           ((<= (count-lines (car c-reg) (nth 1 c-reg)) 2)
 459            (message "Not enough comment lines to hide!"))
 460           (t
 461            (goto-char (nth 1 c-reg))
 462            (hs-hide-block-at-point end t c-reg)
 463            (hs-safety-is-job-n)
 464            (run-hooks 'hs-hide-hook)))
 465        (if (or (looking-at hs-block-start-regexp)
 466                (hs-find-block-beginning))
 467            (progn
 468              (hs-hide-block-at-point end)
 469              (hs-safety-is-job-n)
 470              (run-hooks 'hs-hide-hook)))))))
 471
 472 (defun hs-show-block (&optional end)
 473   "Selects a block and shows it.
 474 With prefix arg, reposition at end.  Upon completion, point is
 475 repositioned and the normal hook `hs-show-hook' is run.
 476 See documentation for `hs-hide-block' and `run-hooks'."
 477   (interactive "P")
 478   (hs-life-goes-on
 479    (let ((c-reg (hs-inside-comment-p)))
 480      (if c-reg
 481          (progn
 482            (hs-flag-region (car c-reg) (nth 1 c-reg) nil)
 483            (hs-safety-is-job-n)
 484            (goto-char (if end (nth 1 c-reg) (car c-reg))))
 485        (if (or (looking-at hs-block-start-regexp)
 486                (hs-find-block-beginning))
 487            (progn
 488              (hs-show-block-at-point end)
 489              (hs-safety-is-job-n)
 490              (run-hooks 'hs-show-hook)))))))
 491
 492 (defun hs-show-region (beg end)
 493   "Shows all lines from BEG to END, without doing any block analysis.
 494 Note:`hs-show-region' is intended for use when `hs-show-block' signals
 495 `unbalanced parentheses' and so is an emergency measure only.  You may
 496 become very confused if you use this command indiscriminately."
 497   (interactive "r")
 498   (hs-life-goes-on
 499    (hs-flag-region beg end nil)
 500    (hs-safety-is-job-n)
 501    (run-hooks 'hs-show-hook)))
 502
 503 ;;;###autoload
 504 (defun hs-mouse-toggle-hiding (e)
 505   "Toggles hiding/showing of a block.
 506 Should be bound to a mouse key."
 507   (interactive "@e")
 508   (mouse-set-point e)
 509   (if (hs-already-hidden-p)
 510       (hs-show-block)
 511     (hs-hide-block)))
 512
 513 ;;;###autoload
 514 (defun hs-minor-mode (&optional arg)
 515   "Toggle hideshow minor mode.
 516 With ARG, turn hideshow minor mode on if ARG is positive, off otherwise.
 517 When hideshow minor mode is on, the menu bar is augmented with hideshow
 518 commands and the hideshow commands are enabled.  The variables
 519 `selective-display' and `selective-display-ellipses' are set to t.
 520 Last, the normal hook `hs-minor-mode-hook' is run; see the doc
 521 for `run-hooks'.
 522
 523 Turning hideshow minor mode off reverts the menu bar and the
 524 variables to default values and disables the hideshow commands."
 525   (interactive "P")
 526   (setq hs-minor-mode
 527         (if (null arg)
 528             (not hs-minor-mode)
 529           (> (prefix-numeric-value arg) 0)))
 530   (if hs-minor-mode
 531       (progn
 532 ;       (if (eq hs-emacs-type 'lucid)
 533 ;           (progn
 534 ;             (set-buffer-menubar (copy-sequence current-menubar))
 535 ;             (add-menu nil (car hs-menu-bar) (cdr hs-menu-bar))))
 536         (make-variable-buffer-local 'line-move-ignore-invisible)
 537         (setq  line-move-ignore-invisible t)
 538         (add-to-invisibility-spec '(hs . t)) ;;hs invisible
 539         (hs-grok-mode-type)
 540         (run-hooks 'hs-minor-mode-hook))
 541 ;    (if (eq hs-emacs-type 'lucid)
 542 ;       (set-buffer-menubar (delete hs-menu-bar current-menubar)))
 543     (remove-from-invisibility-spec '(hs . t))))
 544
 545
 546 ;;;----------------------------------------------------------------------------
 547 ;;; load-time setup routines
 548
 549 ;; which emacs being used?
 550 ;(setq hs-emacs-type
 551 ;      (if (string-match "xemacs\\|lucid" emacs-version)
 552 ;         'lucid
 553 ;       'fsf))
 554
 555 ;; keymaps and menus
 556 (if hs-minor-mode-map
 557     nil
 558   (setq hs-minor-mode-map (make-sparse-keymap))
 559   ;; I beleive there is nothing bound on this keys
 560   (define-key hs-minor-mode-map "\C-ch" 'hs-hide-block)
 561   (define-key hs-minor-mode-map "\C-cs" 'hs-show-block)
 562   (define-key hs-minor-mode-map "\C-cH" 'hs-hide-all)
 563   (define-key hs-minor-mode-map "\C-cS" 'hs-show-all)
 564   (define-key hs-minor-mode-map "\C-cR" 'hs-show-region)
 565
 566   (define-key hs-minor-mode-map [S-mouse-2] 'hs-mouse-toggle-hiding)
 567
 568   ;; should we use easymenu here?
 569   (define-key hs-minor-mode-map [menu-bar Hide/Show]
 570     (cons "Hide/Show" (make-sparse-keymap "Hide/Show")))
 571   (define-key hs-minor-mode-map [menu-bar Hide/Show  hs-show-region]
 572     '("Show Region" . hs-show-region))
 573   (define-key hs-minor-mode-map [menu-bar Hide/Show hs-show-all]
 574     '("Show All" . hs-show-all))
 575   (define-key hs-minor-mode-map [menu-bar Hide/Show hs-hide-all]
 576     '("Hide All" . hs-hide-all))
 577   (define-key hs-minor-mode-map [menu-bar Hide/Show hs-show-block]
 578     '("Show Block" . hs-show-block))
 579   (define-key hs-minor-mode-map [menu-bar Hide/Show hs-hide-block]
 580     '("Hide Block" . hs-hide-block))
 581   )
 582
 583 ;; some housekeeping
 584 (or (assq 'hs-minor-mode minor-mode-map-alist)
 585     (setq minor-mode-map-alist
 586           (cons (cons 'hs-minor-mode hs-minor-mode-map)
 587                 minor-mode-map-alist)))
 588 (or (assq 'hs-minor-mode minor-mode-alist)
 589     (setq minor-mode-alist (append minor-mode-alist
 590                                    (list '(hs-minor-mode " hs")))))
 591
 592 ;; make some variables buffer-local
 593 (make-variable-buffer-local 'hs-minor-mode)
 594 (make-variable-buffer-local 'hs-c-start-regexp)
 595 (make-variable-buffer-local 'hs-c-end-regexp)
 596 (make-variable-buffer-local 'hs-block-start-regexp)
 597 (make-variable-buffer-local 'hs-block-end-regexp)
 598 (make-variable-buffer-local 'hs-forward-sexp-func)
 599 (put 'hs-minor-mode 'permanent-local t)
 600 (put 'hs-c-start-regexp 'permanent-local t)
 601 (put 'hs-c-end-regexp 'permanent-local t)
 602 (put 'hs-block-start-regexp 'permanent-local t)
 603 (put 'hs-block-end-regexp 'permanent-local t)
 604 (put 'hs-forward-sexp-func 'permanent-local t)
 605
 606
 607 ;;;----------------------------------------------------------------------------
 608 ;;; that's it
 609
 610 (provide 'hideshow)
 611
 612 ;;; hideshow.el ends here