1;;; hideshow.el --- minor mode cmds to selectively display code/comment blocks 2 3;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 4;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Thien-Thi Nguyen <ttn@gnu.org> 7;; Dan Nicolaescu <dann@ics.uci.edu> 8;; Keywords: C C++ java lisp tools editing comments blocks hiding outlines 9;; Maintainer-Version: 5.65.2.2 10;; Time-of-Day-Author-Most-Likely-to-be-Recalcitrant: early morning 11 12;; This file is part of GNU Emacs. 13 14;; GNU Emacs is free software; you can redistribute it and/or modify 15;; it under the terms of the GNU General Public License as published by 16;; the Free Software Foundation; either version 2, or (at your option) 17;; any later version. 18 19;; GNU Emacs is distributed in the hope that it will be useful, 20;; but WITHOUT ANY WARRANTY; without even the implied warranty of 21;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 22;; GNU General Public License for more details. 23 24;; You should have received a copy of the GNU General Public License 25;; along with GNU Emacs; see the file COPYING. If not, write to the 26;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 27;; Boston, MA 02110-1301, USA. 28 29;;; Commentary: 30 31;; * Commands provided 32;; 33;; This file provides Hideshow Minor Mode. When active, nine commands 34;; are available, implementing block hiding and showing. They (and their 35;; keybindings) are: 36;; 37;; hs-hide-block C-c @ C-h 38;; hs-show-block C-c @ C-s 39;; hs-hide-all C-c @ C-M-h 40;; hs-show-all C-c @ C-M-s 41;; hs-hide-level C-c @ C-l 42;; hs-toggle-hiding C-c @ C-c 43;; hs-mouse-toggle-hiding [(shift mouse-2)] 44;; hs-hide-initial-comment-block 45;; 46;; Blocks are defined per mode. In c-mode, c++-mode and java-mode, they 47;; are simply text between curly braces, while in Lisp-ish modes parens 48;; are used. Multi-line comment blocks can also be hidden. Read-only 49;; buffers are not a problem, since hideshow doesn't modify the text. 50;; 51;; The command `M-x hs-minor-mode' toggles the minor mode or sets it 52;; (similar to other minor modes). 53 54;; * Suggested usage 55;; 56;; First make sure hideshow.el is in a directory in your `load-path'. 57;; You can optionally byte-compile it using `M-x byte-compile-file'. 58;; Then, add the following to your ~/.emacs: 59;; 60;; (load-library "hideshow") 61;; (add-hook 'X-mode-hook ; other modes similarly 62;; (lambda () (hs-minor-mode 1))) 63;; 64;; where X = {emacs-lisp,c,c++,perl,...}. You can also manually toggle 65;; hideshow minor mode by typing `M-x hs-minor-mode'. After hideshow is 66;; activated or deactivated, `hs-minor-mode-hook' is run w/ `run-hooks'. 67;; 68;; Additionally, Joseph Eydelnant writes: 69;; I enjoy your package hideshow.el Ver. 5.24 2001/02/13 70;; a lot and I've been looking for the following functionality: 71;; toggle hide/show all with a single key. 72;; Here are a few lines of code that lets me do just that. 73;; 74;; (defvar my-hs-hide nil "Current state of hideshow for toggling all.") 75;; ;;;###autoload 76;; (defun my-toggle-hideshow-all () "Toggle hideshow all." 77;; (interactive) 78;; (setq my-hs-hide (not my-hs-hide)) 79;; (if my-hs-hide 80;; (hs-hide-all) 81;; (hs-show-all))) 82;; 83;; [Your hideshow hacks here!] 84 85;; * Customization 86;; 87;; You can use `M-x customize-variable' on the following variables: 88;; 89;; - hs-hide-comments-when-hiding-all -- self-explanatory! 90;; - hs-hide-all-non-comment-function -- if non-nil, when doing a 91;; `hs-hide-all', this function 92;; is called w/ no arguments 93;; - hs-isearch-open -- what kind of hidden blocks to 94;; open when doing isearch 95;; 96;; Some languages (e.g., Java) are deeply nested, so the normal behavior 97;; of `hs-hide-all' (hiding all but top-level blocks) results in very 98;; little information shown, which is not very useful. You can use the 99;; variable `hs-hide-all-non-comment-function' to implement your idea of 100;; what is more useful. For example, the following code shows the next 101;; nested level in addition to the top-level: 102;; 103;; (defun ttn-hs-hide-level-1 () 104;; (hs-hide-level 1) 105;; (forward-sexp 1)) 106;; (setq hs-hide-all-non-comment-function 'ttn-hs-hide-level-1) 107;; 108;; Hideshow works w/ incremental search (isearch) by setting the variable 109;; `hs-headline', which is the line of text at the beginning of a hidden 110;; block that contains a match for the search. You can have this show up 111;; in the mode line by modifying the variable `mode-line-format'. For 112;; example, the following code prepends this info to the mode line: 113;; 114;; (unless (memq 'hs-headline mode-line-format) 115;; (setq mode-line-format 116;; (append '("-" hs-headline) mode-line-format))) 117;; 118;; See documentation for `mode-line-format' for more info. 119;; 120;; Hooks are run after some commands: 121;; 122;; hs-hide-hook in hs-hide-block, hs-hide-all, hs-hide-level 123;; hs-show-hook hs-show-block, hs-show-all 124;; 125;; One of `hs-hide-hook' or `hs-show-hook' is run for the toggling 126;; commands when the result of the toggle is to hide or show blocks, 127;; respectively. All hooks are run w/ `run-hooks'. See docs for each 128;; variable or hook for more info. 129;; 130;; Normally, hideshow tries to determine appropriate values for block 131;; and comment definitions by examining the buffer's major mode. If 132;; there are problems, hideshow will not activate and in that case you 133;; may wish to override hideshow's heuristics by adding an entry to 134;; variable `hs-special-modes-alist'. Packages that use hideshow should 135;; do something like: 136;; 137;; (add-to-list 'hs-special-modes-alist '(my-mode "{{" "}}" ...)) 138;; 139;; If you have an entry that works particularly well, consider 140;; submitting it for inclusion in hideshow.el. See docstring for 141;; `hs-special-modes-alist' for more info on the entry format. 142;; 143;; See also variable `hs-set-up-overlay' for per-block customization of 144;; appearance or other effects associated with overlays. For example: 145;; 146;; (setq hs-set-up-overlay 147;; (defun my-display-code-line-counts (ov) 148;; (when (eq 'code (overlay-get ov 'hs)) 149;; (overlay-put ov 'display 150;; (propertize 151;; (format " ... <%d>" 152;; (count-lines (overlay-start ov) 153;; (overlay-end ov))) 154;; 'face 'font-lock-type-face))))) 155 156;; * Bugs 157;; 158;; (1) Hideshow does not work w/ emacs 18 because emacs 18 lacks the 159;; function `forward-comment' (among other things). If someone 160;; writes this, please send me a copy. 161;; 162;; (2) Sometimes `hs-headline' can become out of sync. To reset, type 163;; `M-x hs-minor-mode' twice (that is, deactivate then re-activate 164;; hideshow). 165;; 166;; (3) Hideshow 5.x is developed and tested on GNU Emacs 20.7. 167;; XEmacs compatibility may have bitrotted since 4.29. 168;; 169;; (4) Some buffers can't be `byte-compile-file'd properly. This is because 170;; `byte-compile-file' inserts the file to be compiled in a temporary 171;; buffer and switches `normal-mode' on. In the case where you have 172;; `hs-hide-initial-comment-block' in `hs-minor-mode-hook', the hiding of 173;; the initial comment sometimes hides parts of the first statement (seems 174;; to be only in `normal-mode'), so there are unbalanced "(" and ")". 175;; 176;; The workaround is to clear `hs-minor-mode-hook' when byte-compiling: 177;; 178;; (defadvice byte-compile-file (around 179;; byte-compile-file-hideshow-off 180;; act) 181;; (let ((hs-minor-mode-hook nil)) 182;; ad-do-it)) 183;; 184;; (5) Hideshow interacts badly with Ediff and `vc-diff'. At the moment, the 185;; suggested workaround is to turn off hideshow entirely, for example: 186;; 187;; (add-hook 'ediff-prepare-buffer-hook 'turn-off-hideshow) 188;; (add-hook 'vc-before-checkin-hook 'turn-off-hideshow) 189;; 190;; In the case of `vc-diff', here is a less invasive workaround: 191;; 192;; (add-hook 'vc-before-checkin-hook 193;; (lambda () 194;; (goto-char (point-min)) 195;; (hs-show-block))) 196;; 197;; Unfortunately, these workarounds do not restore hideshow state. 198;; If someone figures out a better way, please let me know. 199 200;; * Correspondance 201;; 202;; Correspondance welcome; please indicate version number. Send bug 203;; reports and inquiries to <ttn@gnu.org>. 204 205;; * Thanks 206;; 207;; Thanks go to the following people for valuable ideas, code and 208;; bug reports. 209;; 210;; Dean Andrews, Alf-Ivar Holm, Holger Bauer, Christoph Conrad, Dave Love, 211;; Dirk Herrmann, Gael Marziou, Jan Djarv, Guillaume Leray, Moody Ahmad, 212;; Preston F. Crow, Lars Lindberg, Reto Zimmermann, Keith Sheffield, 213;; Chew Meng Kuan, Tony Lam, Pete Ware, Fran�ois Pinard, Stefan Monnier, 214;; Joseph Eydelnant, Michael Ernst, Peter Heslin 215;; 216;; Special thanks go to Dan Nicolaescu, who reimplemented hideshow using 217;; overlays (rather than selective display), added isearch magic, folded 218;; in custom.el compatibility, generalized comment handling, incorporated 219;; mouse support, and maintained the code in general. Version 4.0 is 220;; largely due to his efforts. 221 222;; * History 223;; 224;; Hideshow was inspired when I learned about selective display. It was 225;; reimplemented to use overlays for 4.0 (see above). WRT older history, 226;; entries in the masterfile corresponding to versions 1.x and 2.x have 227;; been lost. XEmacs support is reliable as of 4.29. State save and 228;; restore was added in 3.5 (not widely distributed), and reliable as of 229;; 4.30. Otherwise, the code seems stable. Passes checkdoc as of 4.32. 230;; Version 5.x uses new algorithms for block selection and traversal, 231;; unbundles state save and restore, and includes more isearch support. 232 233;;; Code: 234 235(require 'easymenu) 236 237;;--------------------------------------------------------------------------- 238;; user-configurable variables 239 240(defgroup hideshow nil 241 "Minor mode for hiding and showing program and comment blocks." 242 :prefix "hs-" 243 :group 'languages) 244 245(defcustom hs-hide-comments-when-hiding-all t 246 "*Hide the comments too when you do an `hs-hide-all'." 247 :type 'boolean 248 :group 'hideshow) 249 250(defcustom hs-minor-mode-hook nil 251 "*Hook called when hideshow minor mode is activated or deactivated." 252 :type 'hook 253 :group 'hideshow 254 :version "21.1") 255 256(defcustom hs-isearch-open 'code 257 "*What kind of hidden blocks to open when doing `isearch'. 258One of the following symbols: 259 260 code -- open only code blocks 261 comment -- open only comment blocks 262 t -- open both code and comment blocks 263 nil -- open neither code nor comment blocks 264 265This has effect iff `search-invisible' is set to `open'." 266 :type '(choice (const :tag "open only code blocks" code) 267 (const :tag "open only comment blocks" comment) 268 (const :tag "open both code and comment blocks" t) 269 (const :tag "don't open any of them" nil)) 270 :group 'hideshow) 271 272;;;###autoload 273(defvar hs-special-modes-alist 274 '((c-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning) 275 (c++-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning) 276 (bibtex-mode ("^@\\S(*\\(\\s(\\)" 1)) 277 (java-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning)) 278 "*Alist for initializing the hideshow variables for different modes. 279Each element has the form 280 (MODE START END COMMENT-START FORWARD-SEXP-FUNC ADJUST-BEG-FUNC). 281 282If non-nil, hideshow will use these values as regexps to define blocks 283and comments, respectively for major mode MODE. 284 285START, END and COMMENT-START are regular expressions. A block is 286defined as text surrounded by START and END. 287 288As a special case, START may be a list of the form (COMPLEX-START 289MDATA-SELECTOR), where COMPLEX-START is a regexp w/ multiple parts and 290MDATA-SELECTOR an integer that specifies which sub-match is the proper 291place to adjust point, before calling `hs-forward-sexp-func'. Point 292is adjusted to the beginning of the specified match. For example, 293see the `hs-special-modes-alist' entry for `bibtex-mode'. 294 295For some major modes, `forward-sexp' does not work properly. In those 296cases, FORWARD-SEXP-FUNC specifies another function to use instead. 297 298See the documentation for `hs-adjust-block-beginning' to see what is the 299use of ADJUST-BEG-FUNC. 300 301If any of the elements is left nil or omitted, hideshow tries to guess 302appropriate values. The regexps should not contain leading or trailing 303whitespace. Case does not matter.") 304 305(defvar hs-hide-all-non-comment-function nil 306 "*Function called if non-nil when doing `hs-hide-all' for non-comments.") 307 308(defvar hs-allow-nesting nil 309 "*If non-nil, hiding remembers internal blocks. 310This means that when the outer block is shown again, any 311previously hidden internal blocks remain hidden.") 312 313(defvar hs-hide-hook nil 314 "*Hook called (with `run-hooks') at the end of commands to hide text. 315These commands include the toggling commands (when the result is to hide 316a block), `hs-hide-all', `hs-hide-block' and `hs-hide-level'.") 317 318(defvar hs-show-hook nil 319 "*Hook called (with `run-hooks') at the end of commands to show text. 320These commands include the toggling commands (when the result is to show 321a block), `hs-show-all' and `hs-show-block'..") 322 323(defvar hs-set-up-overlay nil 324 "*Function called with one arg, OV, a newly initialized overlay. 325Hideshow puts a unique overlay on each range of text to be hidden 326in the buffer. Here is a simple example of how to use this variable: 327 328 (defun display-code-line-counts (ov) 329 (when (eq 'code (overlay-get ov 'hs)) 330 (overlay-put ov 'display 331 (format \"... / %d\" 332 (count-lines (overlay-start ov) 333 (overlay-end ov)))))) 334 335 (setq hs-set-up-overlay 'display-code-line-counts) 336 337This example shows how to get information from the overlay as well 338as how to set its `display' property. See `hs-make-overlay' and 339info node `(elisp)Overlays'.") 340 341;;--------------------------------------------------------------------------- 342;; internal variables 343 344(defvar hs-minor-mode nil 345 "Non-nil if using hideshow mode as a minor mode of some other mode. 346Use the command `hs-minor-mode' to toggle or set this variable.") 347 348(defvar hs-minor-mode-map nil 349 "Keymap for hideshow minor mode.") 350 351(defvar hs-minor-mode-menu nil 352 "Menu for hideshow minor mode.") 353 354(defvar hs-c-start-regexp nil 355 "Regexp for beginning of comments. 356Differs from mode-specific comment regexps in that 357surrounding whitespace is stripped.") 358 359(defvar hs-block-start-regexp nil 360 "Regexp for beginning of block.") 361 362(defvar hs-block-start-mdata-select nil 363 "Element in `hs-block-start-regexp' match data to consider as block start. 364The internal function `hs-forward-sexp' moves point to the beginning of this 365element (using `match-beginning') before calling `hs-forward-sexp-func'.") 366 367(defvar hs-block-end-regexp nil 368 "Regexp for end of block.") 369 370(defvar hs-forward-sexp-func 'forward-sexp 371 "Function used to do a `forward-sexp'. 372Should change for Algol-ish modes. For single-character block 373delimiters -- ie, the syntax table regexp for the character is 374either `(' or `)' -- `hs-forward-sexp-func' would just be 375`forward-sexp'. For other modes such as simula, a more specialized 376function is necessary.") 377 378(defvar hs-adjust-block-beginning nil 379 "Function used to tweak the block beginning. 380The block is hidden from the position returned by this function, 381as opposed to hiding it from the position returned when searching 382for `hs-block-start-regexp'. 383 384For example, in c-like modes, if we wish to also hide the curly braces 385\(if you think they occupy too much space on the screen), this function 386should return the starting point (at the end of line) of the hidden 387region. 388 389It is called with a single argument ARG which is the position in 390buffer after the block beginning. 391 392It should return the position from where we should start hiding. 393 394It should not move the point. 395 396See `hs-c-like-adjust-block-beginning' for an example of using this.") 397 398(defvar hs-headline nil 399 "Text of the line where a hidden block begins, set during isearch. 400You can display this in the mode line by adding the symbol `hs-headline' 401to the variable `mode-line-format'. For example, 402 403 (unless (memq 'hs-headline mode-line-format) 404 (setq mode-line-format 405 (append '(\"-\" hs-headline) mode-line-format))) 406 407Note that `mode-line-format' is buffer-local.") 408 409;;--------------------------------------------------------------------------- 410;; system dependency 411 412(defalias 'hs-match-data 'match-data) 413 414;;--------------------------------------------------------------------------- 415;; support functions 416 417(defun hs-discard-overlays (from to) 418 "Delete hideshow overlays in region defined by FROM and TO. 419Skip \"internal\" overlays if `hs-allow-nesting' is non-nil." 420 (when (< to from) 421 (setq from (prog1 to (setq to from)))) 422 (if hs-allow-nesting 423 (let (ov) 424 (while (> to (setq from (next-overlay-change from))) 425 (when (setq ov (hs-overlay-at from)) 426 (setq from (overlay-end ov)) 427 (delete-overlay ov)))) 428 (dolist (ov (overlays-in from to)) 429 (when (overlay-get ov 'hs) 430 (delete-overlay ov))))) 431 432(defun hs-make-overlay (b e kind &optional b-offset e-offset) 433 "Return a new overlay in region defined by B and E with type KIND. 434KIND is either `code' or `comment'. Optional fourth arg B-OFFSET 435when added to B specifies the actual buffer position where the block 436begins. Likewise for optional fifth arg E-OFFSET. If unspecified 437they are taken to be 0 (zero). The following properties are set 438in the overlay: 'invisible 'hs 'hs-b-offset 'hs-e-offset. Also, 439depending on variable `hs-isearch-open', the following properties may 440be present: 'isearch-open-invisible 'isearch-open-invisible-temporary. 441If variable `hs-set-up-overlay' is non-nil it should specify a function 442to call with the newly initialized overlay." 443 (unless b-offset (setq b-offset 0)) 444 (unless e-offset (setq e-offset 0)) 445 (let ((ov (make-overlay b e)) 446 (io (if (eq 'block hs-isearch-open) 447 ;; backward compatibility -- `block'<=>`code' 448 'code 449 hs-isearch-open))) 450 (overlay-put ov 'invisible 'hs) 451 (overlay-put ov 'hs kind) 452 (overlay-put ov 'hs-b-offset b-offset) 453 (overlay-put ov 'hs-e-offset e-offset) 454 (when (or (eq io t) (eq io kind)) 455 (overlay-put ov 'isearch-open-invisible 'hs-isearch-show) 456 (overlay-put ov 'isearch-open-invisible-temporary 457 'hs-isearch-show-temporary)) 458 (when hs-set-up-overlay (funcall hs-set-up-overlay ov)) 459 ov)) 460 461(defun hs-isearch-show (ov) 462 "Delete overlay OV, and set `hs-headline' to nil. 463 464This function is meant to be used as the `isearch-open-invisible' 465property of an overlay." 466 (setq hs-headline nil) 467 (delete-overlay ov)) 468 469(defun hs-isearch-show-temporary (ov hide-p) 470 "Hide or show overlay OV, and set `hs-headline', all depending on HIDE-P. 471If HIDE-P is non-nil, `hs-headline' is set to nil and overlay OV is hidden. 472Otherwise, `hs-headline' is set to the line of text at the head of OV, and 473OV is shown. 474 475This function is meant to be used as the `isearch-open-invisible-temporary' 476property of an overlay." 477 (setq hs-headline 478 (if hide-p 479 nil 480 (or hs-headline 481 (let ((start (overlay-start ov))) 482 (buffer-substring 483 (save-excursion (goto-char start) 484 (beginning-of-line) 485 (skip-chars-forward " \t") 486 (point)) 487 start))))) 488 (force-mode-line-update) 489 ;; handle `display' property specially 490 (let (value) 491 (if hide-p 492 (when (setq value (overlay-get ov 'hs-isearch-display)) 493 (overlay-put ov 'display value) 494 (overlay-put ov 'hs-isearch-display nil)) 495 (when (setq value (overlay-get ov 'display)) 496 (overlay-put ov 'hs-isearch-display value) 497 (overlay-put ov 'display nil)))) 498 (overlay-put ov 'invisible (and hide-p 'hs))) 499 500(defun hs-forward-sexp (match-data arg) 501 "Adjust point based on MATCH-DATA and call `hs-forward-sexp-func' w/ ARG. 502Original match data is restored upon return." 503 (save-match-data 504 (set-match-data match-data) 505 (goto-char (match-beginning hs-block-start-mdata-select)) 506 (funcall hs-forward-sexp-func arg))) 507 508(defun hs-hide-comment-region (beg end &optional repos-end) 509 "Hide a region from BEG to END, marking it as a comment. 510Optional arg REPOS-END means reposition at end." 511 (let ((beg-eol (progn (goto-char beg) (end-of-line) (point))) 512 (end-eol (progn (goto-char end) (end-of-line) (point)))) 513 (hs-discard-overlays beg-eol end-eol) 514 (hs-make-overlay beg-eol end-eol 'comment beg end)) 515 (goto-char (if repos-end end beg))) 516 517(defun hs-hide-block-at-point (&optional end comment-reg) 518 "Hide block iff on block beginning. 519Optional arg END means reposition at end. 520Optional arg COMMENT-REG is a list of the form (BEGIN END) and 521specifies the limits of the comment, or nil if the block is not 522a comment. 523 524The block beginning is adjusted by `hs-adjust-block-beginning' 525and then further adjusted to be at the end of the line." 526 (if comment-reg 527 (hs-hide-comment-region (car comment-reg) (cadr comment-reg) end) 528 (when (looking-at hs-block-start-regexp) 529 (let* ((mdata (hs-match-data t)) 530 (pure-p (match-end 0)) 531 (p 532 ;; `p' is the point at the end of the block beginning, 533 ;; which may need to be adjusted 534 (save-excursion 535 (goto-char (funcall (or hs-adjust-block-beginning 536 'identity) 537 pure-p)) 538 ;; whatever the adjustment, we move to eol 539 (end-of-line) 540 (point))) 541 (q 542 ;; `q' is the point at the end of the block 543 (progn (hs-forward-sexp mdata 1) 544 (end-of-line) 545 (point))) 546 ov) 547 (when (and (< p (point)) (> (count-lines p q) 1)) 548 (cond ((and hs-allow-nesting (setq ov (hs-overlay-at p))) 549 (delete-overlay ov)) 550 ((not hs-allow-nesting) 551 (hs-discard-overlays p q))) 552 (hs-make-overlay p q 'code (- pure-p p))) 553 (goto-char (if end q (min p pure-p))))))) 554 555(defun hs-inside-comment-p () 556 "Return non-nil if point is inside a comment, otherwise nil. 557Actually, return a list containing the buffer position of the start 558and the end of the comment. A comment block can be hidden only if on 559its starting line there is only whitespace preceding the actual comment 560beginning. If we are inside of a comment but this condition is not met, 561we return a list having a nil as its car and the end of comment position 562as cdr." 563 (save-excursion 564 ;; the idea is to look backwards for a comment start regexp, do a 565 ;; forward comment, and see if we are inside, then extend extend 566 ;; forward and backward as long as we have comments 567 (let ((q (point))) 568 (when (or (looking-at hs-c-start-regexp) 569 (re-search-backward hs-c-start-regexp (point-min) t)) 570 ;; first get to the beginning of this comment... 571 (while (and (not (bobp)) 572 (= (point) (progn (forward-comment -1) (point)))) 573 (forward-char -1)) 574 ;; ...then extend backwards 575 (forward-comment (- (buffer-size))) 576 (skip-chars-forward " \t\n\f") 577 (let ((p (point)) 578 (hidable t)) 579 (beginning-of-line) 580 (unless (looking-at (concat "[ \t]*" hs-c-start-regexp)) 581 ;; we are in this situation: (example) 582 ;; (defun bar () 583 ;; (foo) 584 ;; ) ; comment 585 ;; ^ 586 ;; the point was here before doing (beginning-of-line) 587 ;; here we should advance till the next comment which 588 ;; eventually has only white spaces preceding it on the same 589 ;; line 590 (goto-char p) 591 (forward-comment 1) 592 (skip-chars-forward " \t\n\f") 593 (setq p (point)) 594 (while (and (< (point) q) 595 (> (point) p) 596 (not (looking-at hs-c-start-regexp))) 597 ;; avoid an infinite cycle 598 (setq p (point)) 599 (forward-comment 1) 600 (skip-chars-forward " \t\n\f")) 601 (when (or (not (looking-at hs-c-start-regexp)) 602 (> (point) q)) 603 ;; we cannot hide this comment block 604 (setq hidable nil))) 605 ;; goto the end of the comment 606 (forward-comment (buffer-size)) 607 (skip-chars-backward " \t\n\f") 608 (end-of-line) 609 (when (>= (point) q) 610 (list (and hidable p) (point)))))))) 611 612(defun hs-grok-mode-type () 613 "Set up hideshow variables for new buffers. 614If `hs-special-modes-alist' has information associated with the 615current buffer's major mode, use that. 616Otherwise, guess start, end and `comment-start' regexps; `forward-sexp' 617function; and adjust-block-beginning function." 618 (if (and (boundp 'comment-start) 619 (boundp 'comment-end) 620 comment-start comment-end) 621 (let* ((lookup (assoc major-mode hs-special-modes-alist)) 622 (start-elem (or (nth 1 lookup) "\\s("))) 623 (if (listp start-elem) 624 ;; handle (START-REGEXP MDATA-SELECT) 625 (setq hs-block-start-regexp (car start-elem) 626 hs-block-start-mdata-select (cadr start-elem)) 627 ;; backwards compatibility: handle simple START-REGEXP 628 (setq hs-block-start-regexp start-elem 629 hs-block-start-mdata-select 0)) 630 (setq hs-block-end-regexp (or (nth 2 lookup) "\\s)") 631 hs-c-start-regexp (or (nth 3 lookup) 632 (let ((c-start-regexp 633 (regexp-quote comment-start))) 634 (if (string-match " +$" c-start-regexp) 635 (substring c-start-regexp 636 0 (1- (match-end 0))) 637 c-start-regexp))) 638 hs-forward-sexp-func (or (nth 4 lookup) 'forward-sexp) 639 hs-adjust-block-beginning (nth 5 lookup))) 640 (setq hs-minor-mode nil) 641 (error "%s Mode doesn't support Hideshow Minor Mode" mode-name))) 642 643(defun hs-find-block-beginning () 644 "Reposition point at block-start. 645Return point, or nil if original point was not in a block." 646 (let ((done nil) 647 (here (point))) 648 ;; look if current line is block start 649 (if (looking-at hs-block-start-regexp) 650 (point) 651 ;; look backward for the start of a block that contains the cursor 652 (while (and (re-search-backward hs-block-start-regexp nil t) 653 (not (setq done 654 (< here (save-excursion 655 (hs-forward-sexp (hs-match-data t) 1) 656 (point))))))) 657 (if done 658 (point) 659 (goto-char here) 660 nil)))) 661 662(defun hs-hide-level-recursive (arg minp maxp) 663 "Recursively hide blocks ARG levels below point in region (MINP MAXP)." 664 (when (hs-find-block-beginning) 665 (setq minp (1+ (point))) 666 (funcall hs-forward-sexp-func 1) 667 (setq maxp (1- (point)))) 668 (unless hs-allow-nesting 669 (hs-discard-overlays minp maxp)) 670 (goto-char minp) 671 (while (progn 672 (forward-comment (buffer-size)) 673 (and (< (point) maxp) 674 (re-search-forward hs-block-start-regexp maxp t))) 675 (if (> arg 1) 676 (hs-hide-level-recursive (1- arg) minp maxp) 677 (goto-char (match-beginning hs-block-start-mdata-select)) 678 (hs-hide-block-at-point t))) 679 (goto-char maxp)) 680 681(defmacro hs-life-goes-on (&rest body) 682 "Evaluate BODY forms iff variable `hs-minor-mode' is non-nil. 683In the dynamic context of this macro, `inhibit-point-motion-hooks' 684and `case-fold-search' are both t." 685 `(when hs-minor-mode 686 (let ((inhibit-point-motion-hooks t) 687 (case-fold-search t)) 688 ,@body))) 689 690(put 'hs-life-goes-on 'edebug-form-spec '(&rest form)) 691 692(defun hs-overlay-at (position) 693 "Return hideshow overlay at POSITION, or nil if none to be found." 694 (let ((overlays (overlays-at position)) 695 ov found) 696 (while (and (not found) (setq ov (car overlays))) 697 (setq found (and (overlay-get ov 'hs) ov) 698 overlays (cdr overlays))) 699 found)) 700 701(defun hs-already-hidden-p () 702 "Return non-nil if point is in an already-hidden block, otherwise nil." 703 (save-excursion 704 (let ((c-reg (hs-inside-comment-p))) 705 (if (and c-reg (nth 0 c-reg)) 706 ;; point is inside a comment, and that comment is hidable 707 (goto-char (nth 0 c-reg)) 708 (end-of-line) 709 (when (and (not c-reg) 710 (hs-find-block-beginning) 711 (looking-at hs-block-start-regexp)) 712 ;; point is inside a block 713 (goto-char (match-end 0))))) 714 (end-of-line) 715 (hs-overlay-at (point)))) 716 717(defun hs-c-like-adjust-block-beginning (initial) 718 "Adjust INITIAL, the buffer position after `hs-block-start-regexp'. 719Actually, point is never moved; a new position is returned that is 720the end of the C-function header. This adjustment function is meant 721to be assigned to `hs-adjust-block-beginning' for C-like modes." 722 (save-excursion 723 (goto-char (1- initial)) 724 (forward-comment (- (buffer-size))) 725 (point))) 726 727;;--------------------------------------------------------------------------- 728;; commands 729 730(defun hs-hide-all () 731 "Hide all top level blocks, displaying only first and last lines. 732Move point to the beginning of the line, and run the normal hook 733`hs-hide-hook'. See documentation for `run-hooks'. 734If `hs-hide-comments-when-hiding-all' is non-nil, also hide the comments." 735 (interactive) 736 (hs-life-goes-on 737 (message "Hiding all blocks ...") 738 (save-excursion 739 (unless hs-allow-nesting 740 (hs-discard-overlays (point-min) (point-max))) 741 (goto-char (point-min)) 742 (let ((count 0) 743 (re (concat "\\(" 744 hs-block-start-regexp 745 "\\)" 746 (if hs-hide-comments-when-hiding-all 747 (concat "\\|\\(" 748 hs-c-start-regexp 749 "\\)") 750 "")))) 751 (while (progn 752 (unless hs-hide-comments-when-hiding-all 753 (forward-comment (point-max))) 754 (re-search-forward re (point-max) t)) 755 (if (match-beginning 1) 756 ;; we have found a block beginning 757 (progn 758 (goto-char (match-beginning 1)) 759 (if hs-hide-all-non-comment-function 760 (funcall hs-hide-all-non-comment-function) 761 (hs-hide-block-at-point t))) 762 ;; found a comment, probably 763 (let ((c-reg (hs-inside-comment-p))) 764 (when (and c-reg (car c-reg)) 765 (if (> (count-lines (car c-reg) (nth 1 c-reg)) 1) 766 (hs-hide-block-at-point t c-reg) 767 (goto-char (nth 1 c-reg)))))) 768 (message "Hiding ... %d" (setq count (1+ count)))))) 769 (beginning-of-line) 770 (message "Hiding all blocks ... done") 771 (run-hooks 'hs-hide-hook))) 772 773(defun hs-show-all () 774 "Show everything then run `hs-show-hook'. See `run-hooks'." 775 (interactive) 776 (hs-life-goes-on 777 (message "Showing all blocks ...") 778 (let ((hs-allow-nesting nil)) 779 (hs-discard-overlays (point-min) (point-max))) 780 (message "Showing all blocks ... done") 781 (run-hooks 'hs-show-hook))) 782 783(defun hs-hide-block (&optional end) 784 "Select a block and hide it. With prefix arg, reposition at END. 785Upon completion, point is repositioned and the normal hook 786`hs-hide-hook' is run. See documentation for `run-hooks'." 787 (interactive "P") 788 (hs-life-goes-on 789 (let ((c-reg (hs-inside-comment-p))) 790 (cond 791 ((and c-reg (or (null (nth 0 c-reg)) 792 (<= (count-lines (car c-reg) (nth 1 c-reg)) 1))) 793 (message "(not enough comment lines to hide)")) 794 ((or c-reg 795 (looking-at hs-block-start-regexp) 796 (hs-find-block-beginning)) 797 (hs-hide-block-at-point end c-reg) 798 (run-hooks 'hs-hide-hook)))))) 799 800(defun hs-show-block (&optional end) 801 "Select a block and show it. 802With prefix arg, reposition at END. Upon completion, point is 803repositioned and the normal hook `hs-show-hook' is run. 804See documentation for functions `hs-hide-block' and `run-hooks'." 805 (interactive "P") 806 (hs-life-goes-on 807 (or 808 ;; first see if we have something at the end of the line 809 (let ((ov (hs-overlay-at (save-excursion (end-of-line) (point)))) 810 (here (point))) 811 (when ov 812 (goto-char 813 (cond (end (overlay-end ov)) 814 ((eq 'comment (overlay-get ov 'hs)) here) 815 (t (+ (overlay-start ov) (overlay-get ov 'hs-b-offset))))) 816 (delete-overlay ov) 817 t)) 818 ;; not immediately obvious, look for a suitable block 819 (let ((c-reg (hs-inside-comment-p)) 820 p q) 821 (cond (c-reg 822 (when (car c-reg) 823 (setq p (car c-reg) 824 q (cadr c-reg)))) 825 ((and (hs-find-block-beginning) 826 ;; ugh, fresh match-data 827 (looking-at hs-block-start-regexp)) 828 (setq p (point) 829 q (progn (hs-forward-sexp (hs-match-data t) 1) (point))))) 830 (when (and p q) 831 (hs-discard-overlays p q) 832 (goto-char (if end q (1+ p))))) 833 (run-hooks 'hs-show-hook)))) 834 835(defun hs-hide-level (arg) 836 "Hide all blocks ARG levels below this block. 837The hook `hs-hide-hook' is run; see `run-hooks'." 838 (interactive "p") 839 (hs-life-goes-on 840 (save-excursion 841 (message "Hiding blocks ...") 842 (hs-hide-level-recursive arg (point-min) (point-max)) 843 (message "Hiding blocks ... done")) 844 (run-hooks 'hs-hide-hook))) 845 846(defun hs-toggle-hiding () 847 "Toggle hiding/showing of a block. 848See `hs-hide-block' and `hs-show-block'." 849 (interactive) 850 (hs-life-goes-on 851 (if (hs-already-hidden-p) 852 (hs-show-block) 853 (hs-hide-block)))) 854 855(defun hs-mouse-toggle-hiding (e) 856 "Toggle hiding/showing of a block. 857This command should be bound to a mouse key. 858Argument E is a mouse event used by `mouse-set-point'. 859See `hs-hide-block' and `hs-show-block'." 860 (interactive "@e") 861 (hs-life-goes-on 862 (mouse-set-point e) 863 (hs-toggle-hiding))) 864 865(defun hs-hide-initial-comment-block () 866 "Hide the first block of comments in a file. 867This can be useful if you have huge RCS logs in those comments." 868 (interactive) 869 (hs-life-goes-on 870 (let ((c-reg (save-excursion 871 (goto-char (point-min)) 872 (skip-chars-forward " \t\n\f") 873 (hs-inside-comment-p)))) 874 (when c-reg 875 (let ((beg (car c-reg)) (end (cadr c-reg))) 876 ;; see if we have enough comment lines to hide 877 (when (> (count-lines beg end) 1) 878 (hs-hide-comment-region beg end))))))) 879 880;;;###autoload 881(defun hs-minor-mode (&optional arg) 882 "Toggle hideshow minor mode. 883With ARG, turn hideshow minor mode on if ARG is positive, off otherwise. 884When hideshow minor mode is on, the menu bar is augmented with hideshow 885commands and the hideshow commands are enabled. 886The value '(hs . t) is added to `buffer-invisibility-spec'. 887 888The main commands are: `hs-hide-all', `hs-show-all', `hs-hide-block', 889`hs-show-block', `hs-hide-level' and `hs-toggle-hiding'. There is also 890`hs-hide-initial-comment-block' and `hs-mouse-toggle-hiding'. 891 892Turning hideshow minor mode off reverts the menu bar and the 893variables to default values and disables the hideshow commands. 894 895Lastly, the normal hook `hs-minor-mode-hook' is run using `run-hooks'. 896 897Key bindings: 898\\{hs-minor-mode-map}" 899 900 (interactive "P") 901 (setq hs-headline nil 902 hs-minor-mode (if (null arg) 903 (not hs-minor-mode) 904 (> (prefix-numeric-value arg) 0))) 905 (if hs-minor-mode 906 (progn 907 (hs-grok-mode-type) 908 ;; Turn off this mode if we change major modes. 909 (add-hook 'change-major-mode-hook 910 'turn-off-hideshow 911 nil t) 912 (easy-menu-add hs-minor-mode-menu) 913 (set (make-local-variable 'line-move-ignore-invisible) t) 914 (add-to-invisibility-spec '(hs . t))) 915 (easy-menu-remove hs-minor-mode-menu) 916 (remove-from-invisibility-spec '(hs . t)) 917 ;; hs-show-all does nothing unless h-m-m is non-nil. 918 (let ((hs-minor-mode t)) 919 (hs-show-all))) 920 (run-hooks 'hs-minor-mode-hook)) 921 922;;;###autoload 923(defun turn-off-hideshow () 924 "Unconditionally turn off `hs-minor-mode'." 925 (hs-minor-mode -1)) 926 927;;--------------------------------------------------------------------------- 928;; load-time actions 929 930;; keymaps and menus 931(unless hs-minor-mode-map 932 (setq hs-minor-mode-map (make-sparse-keymap)) 933 (easy-menu-define hs-minor-mode-menu 934 hs-minor-mode-map 935 "Menu used when hideshow minor mode is active." 936 (cons "Hide/Show" 937 (mapcar 938 ;; Interpret each table entry as follows: first, populate keymap 939 ;; with elements 2 and 1; then, for easymenu, use entry directly 940 ;; unless element 0 is nil, in which case the entry is "omitted". 941 (lambda (ent) 942 (define-key hs-minor-mode-map (aref ent 2) (aref ent 1)) 943 (if (aref ent 0) ent "-----")) 944 ;; These bindings roughly imitate those used by Outline mode. 945 ;; menu entry command key 946 '(["Hide Block" hs-hide-block "\C-c@\C-h"] 947 ["Show Block" hs-show-block "\C-c@\C-s"] 948 ["Hide All" hs-hide-all "\C-c@\C-\M-h"] 949 ["Show All" hs-show-all "\C-c@\C-\M-s"] 950 ["Hide Level" hs-hide-level "\C-c@\C-l"] 951 ["Toggle Hiding" hs-toggle-hiding "\C-c@\C-c"] 952 [nil hs-mouse-toggle-hiding [(shift mouse-2)]] 953 ))))) 954 955;; some housekeeping 956(add-to-list 'minor-mode-map-alist (cons 'hs-minor-mode hs-minor-mode-map)) 957(add-to-list 'minor-mode-alist '(hs-minor-mode " hs") t) 958 959;; make some variables buffer-local 960(dolist (var '(hs-minor-mode 961 hs-c-start-regexp 962 hs-block-start-regexp 963 hs-block-start-mdata-select 964 hs-block-end-regexp 965 hs-forward-sexp-func 966 hs-adjust-block-beginning)) 967 (make-variable-buffer-local var)) 968 969;;--------------------------------------------------------------------------- 970;; that's it 971 972(provide 'hideshow) 973 974;;; arch-tag: 378b6852-e82a-466a-aee8-d9c73859a65e 975;;; hideshow.el ends here 976