X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/ffe832ea680b4820f5ff399191f7f2d41350ee2e..acaf905b1130aae80fa59d2c861ffd4c8eb75486:/lisp/progmodes/hideshow.el diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index dcda521f14..c9ba5ef281 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -1,7 +1,6 @@ ;;; hideshow.el --- minor mode cmds to selectively display code/comment blocks -;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 -;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 1994-2012 Free Software Foundation, Inc. ;; Author: Thien-Thi Nguyen ;; Dan Nicolaescu @@ -11,10 +10,10 @@ ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -22,9 +21,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -197,9 +194,9 @@ ;; Unfortunately, these workarounds do not restore hideshow state. ;; If someone figures out a better way, please let me know. -;; * Correspondance +;; * Correspondence ;; -;; Correspondance welcome; please indicate version number. Send bug +;; Correspondence welcome; please indicate version number. Send bug ;; reports and inquiries to . ;; * Thanks @@ -232,8 +229,6 @@ ;;; Code: -(require 'easymenu) - ;;--------------------------------------------------------------------------- ;; user-configurable variables @@ -271,10 +266,12 @@ This has effect only if `search-invisible' is set to `open'." ;;;###autoload (defvar hs-special-modes-alist - '((c-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning) - (c++-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning) - (bibtex-mode ("^@\\S(*\\(\\s(\\)" 1)) - (java-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning)) + (mapcar 'purecopy + '((c-mode "{" "}" "/[*/]" nil nil) + (c++-mode "{" "}" "/[*/]" nil nil) + (bibtex-mode ("@\\S(*\\(\\s(\\)" 1)) + (java-mode "{" "}" "/[*/]" nil nil) + (js-mode "{" "}" "/[*/]" nil))) "*Alist for initializing the hideshow variables for different modes. Each element has the form (MODE START END COMMENT-START FORWARD-SEXP-FUNC ADJUST-BEG-FUNC). @@ -307,8 +304,8 @@ whitespace. Case does not matter.") (defvar hs-allow-nesting nil "*If non-nil, hiding remembers internal blocks. -This means that when the outer block is shown again, any -previously hidden internal blocks remain hidden.") +This means that when the outer block is shown again, +any previously hidden internal blocks remain hidden.") (defvar hs-hide-hook nil "*Hook called (with `run-hooks') at the end of commands to hide text. @@ -318,7 +315,7 @@ a block), `hs-hide-all', `hs-hide-block' and `hs-hide-level'.") (defvar hs-show-hook nil "*Hook called (with `run-hooks') at the end of commands to show text. These commands include the toggling commands (when the result is to show -a block), `hs-show-all' and `hs-show-block'..") +a block), `hs-show-all' and `hs-show-block'.") (defvar hs-set-up-overlay nil "*Function called with one arg, OV, a newly initialized overlay. @@ -368,11 +365,30 @@ Use the command `hs-minor-mode' to toggle or set this variable.") ["Hide All" hs-hide-all :help "Hide all the blocks in the buffer"] ["Show All" hs-show-all - :help "Show all the clocks in the buffer"] + :help "Show all the blocks in the buffer"] ["Hide Level" hs-hide-level :help "Hide all block at levels below the current block"] ["Toggle Hiding" hs-toggle-hiding - :help "Toggle the hiding state of the current block"])) + :help "Toggle the hiding state of the current block"] + "----" + ["Hide comments when hiding all" + (setq hs-hide-comments-when-hiding-all + (not hs-hide-comments-when-hiding-all)) + :help "If t also hide comment blocks when doing `hs-hide-all'" + :style toggle :selected hs-hide-comments-when-hiding-all] + ("Reveal on isearch" + ["Code blocks" (setq hs-isearch-open 'code) + :help "Show hidden code blocks when isearch matches inside them" + :active t :style radio :selected (eq hs-isearch-open 'code)] + ["Comment blocks" (setq hs-isearch-open 'comment) + :help "Show hidden comment blocks when isearch matches inside them" + :active t :style radio :selected (eq hs-isearch-open 'comment)] + ["Code and Comment blocks" (setq hs-isearch-open t) + :help "Show both hidden code and comment blocks when isearch matches inside them" + :active t :style radio :selected (eq hs-isearch-open t)] + ["None" (setq hs-isearch-open nil) + :help "Do not hidden code or comment blocks when isearch matches inside them" + :active t :style radio :selected (eq hs-isearch-open nil)]))) (defvar hs-c-start-regexp nil "Regexp for beginning of comments. @@ -520,6 +536,11 @@ property of an overlay." (overlay-put ov 'display nil)))) (overlay-put ov 'invisible (and hide-p 'hs))) +(defun hs-looking-at-block-start-p () + "Return non-nil if the point is at the block start." + (and (looking-at hs-block-start-regexp) + (save-match-data (not (nth 8 (syntax-ppss)))))) + (defun hs-forward-sexp (match-data arg) "Adjust point based on MATCH-DATA and call `hs-forward-sexp-func' w/ ARG. Original match data is restored upon return." @@ -548,31 +569,30 @@ The block beginning is adjusted by `hs-adjust-block-beginning' and then further adjusted to be at the end of the line." (if comment-reg (hs-hide-comment-region (car comment-reg) (cadr comment-reg) end) - (when (looking-at hs-block-start-regexp) - (let* ((mdata (match-data t)) - (pure-p (match-end 0)) - (p - ;; `p' is the point at the end of the block beginning, - ;; which may need to be adjusted - (save-excursion - (goto-char (funcall (or hs-adjust-block-beginning - 'identity) - pure-p)) - ;; whatever the adjustment, we move to eol - (line-end-position))) - (q - ;; `q' is the point at the end of the block - (progn (hs-forward-sexp mdata 1) - (end-of-line) - (point))) - ov) - (when (and (< p (point)) (> (count-lines p q) 1)) + (when (hs-looking-at-block-start-p) + (let ((mdata (match-data t)) + (header-end (match-end 0)) + p q ov) + ;; `p' is the point at the end of the block beginning, which + ;; may need to be adjusted + (save-excursion + (if hs-adjust-block-beginning + (goto-char (funcall hs-adjust-block-beginning + header-end)) + (goto-char header-end)) + (setq p (line-end-position))) + ;; `q' is the point at the end of the block + (hs-forward-sexp mdata 1) + (setq q (if (looking-back hs-block-end-regexp) + (match-beginning 0) + (point))) + (when (and (< p q) (> (count-lines p q) 1)) (cond ((and hs-allow-nesting (setq ov (hs-overlay-at p))) (delete-overlay ov)) ((not hs-allow-nesting) (hs-discard-overlays p q))) - (hs-make-overlay p q 'code (- pure-p p))) - (goto-char (if end q (min p pure-p))))))) + (hs-make-overlay p q 'code (- header-end p))) + (goto-char (if end q (min p header-end))))))) (defun hs-inside-comment-p () "Return non-nil if point is inside a comment, otherwise nil. @@ -669,14 +689,16 @@ Return point, or nil if original point was not in a block." (let ((done nil) (here (point))) ;; look if current line is block start - (if (looking-at hs-block-start-regexp) + (if (hs-looking-at-block-start-p) (point) ;; look backward for the start of a block that contains the cursor (while (and (re-search-backward hs-block-start-regexp nil t) - (not (setq done - (< here (save-excursion - (hs-forward-sexp (match-data t) 1) - (point))))))) + ;; go again if in a comment or a string + (or (save-match-data (nth 8 (syntax-ppss))) + (not (setq done + (< here (save-excursion + (hs-forward-sexp (match-data t) 1) + (point)))))))) (if done (point) (goto-char here) @@ -695,10 +717,12 @@ Return point, or nil if original point was not in a block." (forward-comment (buffer-size)) (and (< (point) maxp) (re-search-forward hs-block-start-regexp maxp t))) - (if (> arg 1) - (hs-hide-level-recursive (1- arg) minp maxp) - (goto-char (match-beginning hs-block-start-mdata-select)) - (hs-hide-block-at-point t))) + (when (save-match-data + (not (nth 8 (syntax-ppss)))) ; not inside comments or strings + (if (> arg 1) + (hs-hide-level-recursive (1- arg) minp maxp) + (goto-char (match-beginning hs-block-start-mdata-select)) + (hs-hide-block-at-point t)))) (goto-char maxp)) (defmacro hs-life-goes-on (&rest body) @@ -731,12 +755,13 @@ and `case-fold-search' are both t." (end-of-line) (when (and (not c-reg) (hs-find-block-beginning) - (looking-at hs-block-start-regexp)) + (hs-looking-at-block-start-p)) ;; point is inside a block (goto-char (match-end 0))))) (end-of-line) (hs-overlay-at (point)))) +;; This function is not used anymore (Bug#700). (defun hs-c-like-adjust-block-beginning (initial) "Adjust INITIAL, the buffer position after `hs-block-start-regexp'. Actually, point is never moved; a new position is returned that is @@ -815,7 +840,7 @@ Upon completion, point is repositioned and the normal hook (<= (count-lines (car c-reg) (nth 1 c-reg)) 1))) (message "(not enough comment lines to hide)")) ((or c-reg - (looking-at hs-block-start-regexp) + (hs-looking-at-block-start-p) (hs-find-block-beginning)) (hs-hide-block-at-point end c-reg) (run-hooks 'hs-hide-hook)))))) @@ -847,13 +872,13 @@ See documentation for functions `hs-hide-block' and `run-hooks'." q (cadr c-reg)))) ((and (hs-find-block-beginning) ;; ugh, fresh match-data - (looking-at hs-block-start-regexp)) + (hs-looking-at-block-start-p)) (setq p (point) q (progn (hs-forward-sexp (match-data t) 1) (point))))) (when (and p q) (hs-discard-overlays p q) - (goto-char (if end q (1+ p))))) - (run-hooks 'hs-show-hook)))) + (goto-char (if end q (1+ p)))))) + (run-hooks 'hs-show-hook))) (defun hs-hide-level (arg) "Hide all blocks ARG levels below this block. @@ -902,7 +927,7 @@ This can be useful if you have huge RCS logs in those comments." ;;;###autoload (define-minor-mode hs-minor-mode - "Minor mode to selectively hide/show code and comment blocks. + "Minor mode to selectively hide/show code and comment blocks. When hideshow minor mode is on, the menu bar is augmented with hideshow commands and the hideshow commands are enabled. The value '(hs . t) is added to `buffer-invisibility-spec'. @@ -918,7 +943,7 @@ Lastly, the normal hook `hs-minor-mode-hook' is run using `run-hooks'. Key bindings: \\{hs-minor-mode-map}" - :group 'hideshow + :group 'hideshow :lighter " hs" :keymap hs-minor-mode-map (setq hs-headline nil) @@ -947,5 +972,4 @@ Key bindings: (provide 'hideshow) -;; arch-tag: 378b6852-e82a-466a-aee8-d9c73859a65e ;;; hideshow.el ends here