;;; 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 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2012 Free Software Foundation, Inc.
;; Author: Thien-Thi Nguyen <ttn@gnu.org>
;; Dan Nicolaescu <dann@ics.uci.edu>
;; 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
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;; 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 <ttn@gnu.org>.
;; * Thanks
;;; Code:
-(require 'easymenu)
-
;;---------------------------------------------------------------------------
;; user-configurable variables
;;;###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).
(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.
(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.
"Non-nil if using hideshow mode as a minor mode of some other mode.
Use the command `hs-minor-mode' to toggle or set this variable.")
-(defvar hs-minor-mode-map nil
+(defvar hs-minor-mode-map
+ (let ((map (make-sparse-keymap)))
+ ;; These bindings roughly imitate those used by Outline mode.
+ (define-key map "\C-c@\C-h" 'hs-hide-block)
+ (define-key map "\C-c@\C-s" 'hs-show-block)
+ (define-key map "\C-c@\C-\M-h" 'hs-hide-all)
+ (define-key map "\C-c@\C-\M-s" 'hs-show-all)
+ (define-key map "\C-c@\C-l" 'hs-hide-level)
+ (define-key map "\C-c@\C-c" 'hs-toggle-hiding)
+ (define-key map [(shift mouse-2)] 'hs-mouse-toggle-hiding)
+ map)
"Keymap for hideshow minor mode.")
-(defvar hs-minor-mode-menu nil
- "Menu for hideshow minor mode.")
+(easy-menu-define hs-minor-mode-menu hs-minor-mode-map
+ "Menu used when hideshow minor mode is active."
+ '("Hide/Show"
+ ["Hide Block" hs-hide-block
+ :help "Hide the code or comment block at point"]
+ ["Show Block" hs-show-block
+ :help "Show the code or comment block at point"]
+ ["Hide All" hs-hide-all
+ :help "Hide all the blocks in the buffer"]
+ ["Show All" hs-show-all
+ :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"]
+ "----"
+ ["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.
Differs from mode-specific comment regexps in that
surrounding whitespace is stripped.")
+(make-variable-buffer-local 'hs-c-start-regexp)
(defvar hs-block-start-regexp nil
"Regexp for beginning of block.")
+(make-variable-buffer-local 'hs-block-start-regexp)
(defvar hs-block-start-mdata-select nil
"Element in `hs-block-start-regexp' match data to consider as block start.
The internal function `hs-forward-sexp' moves point to the beginning of this
element (using `match-beginning') before calling `hs-forward-sexp-func'.")
+(make-variable-buffer-local 'hs-block-start-mdata-select)
(defvar hs-block-end-regexp nil
"Regexp for end of block.")
either `(' or `)' -- `hs-forward-sexp-func' would just be
`forward-sexp'. For other modes such as simula, a more specialized
function is necessary.")
+(make-variable-buffer-local 'hs-forward-sexp-func)
(defvar hs-adjust-block-beginning nil
"Function used to tweak the block beginning.
It should not move the point.
See `hs-c-like-adjust-block-beginning' for an example of using this.")
+(make-variable-buffer-local 'hs-adjust-block-beginning)
(defvar hs-headline nil
"Text of the line where a hidden block begins, set during isearch.
(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."
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.
hs-forward-sexp-func (or (nth 4 lookup) 'forward-sexp)
hs-adjust-block-beginning (nth 5 lookup)))
(setq hs-minor-mode nil)
- (error "%s Mode doesn't support Hideshow Minor Mode" mode-name)))
+ (error "%s Mode doesn't support Hideshow Minor Mode"
+ (format-mode-line mode-name))))
(defun hs-find-block-beginning ()
"Reposition point at block-start.
(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)
(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)
(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
(<= (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))))))
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.
(hs-hide-comment-region beg end)))))))
;;;###autoload
-(defun hs-minor-mode (&optional arg)
- "Toggle hideshow minor mode.
-With ARG, turn hideshow minor mode on if ARG is positive, off otherwise.
+(define-minor-mode hs-minor-mode
+ "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'.
Key bindings:
\\{hs-minor-mode-map}"
-
- (interactive "P")
- (setq hs-headline nil
- hs-minor-mode (if (null arg)
- (not hs-minor-mode)
- (> (prefix-numeric-value arg) 0)))
+ :group 'hideshow
+ :lighter " hs"
+ :keymap hs-minor-mode-map
+ (setq hs-headline nil)
(if hs-minor-mode
(progn
(hs-grok-mode-type)
(easy-menu-add hs-minor-mode-menu)
(set (make-local-variable 'line-move-ignore-invisible) t)
(add-to-invisibility-spec '(hs . t)))
- (easy-menu-remove hs-minor-mode-menu)
(remove-from-invisibility-spec '(hs . t))
;; hs-show-all does nothing unless h-m-m is non-nil.
(let ((hs-minor-mode t))
- (hs-show-all)))
- (run-hooks 'hs-minor-mode-hook))
+ (hs-show-all))))
;;;###autoload
(defun turn-off-hideshow ()
"Unconditionally turn off `hs-minor-mode'."
(hs-minor-mode -1))
-;;---------------------------------------------------------------------------
-;; load-time actions
-
-;; keymaps and menus
-(unless hs-minor-mode-map
- (setq hs-minor-mode-map (make-sparse-keymap))
- (easy-menu-define hs-minor-mode-menu
- hs-minor-mode-map
- "Menu used when hideshow minor mode is active."
- (cons "Hide/Show"
- (mapcar
- ;; Interpret each table entry as follows: first, populate keymap
- ;; with elements 2 and 1; then, for easymenu, use entry directly
- ;; unless element 0 is nil, in which case the entry is "omitted".
- (lambda (ent)
- (define-key hs-minor-mode-map (aref ent 2) (aref ent 1))
- (if (aref ent 0) ent "-----"))
- ;; These bindings roughly imitate those used by Outline mode.
- ;; menu entry command key
- '(["Hide Block" hs-hide-block "\C-c@\C-h"]
- ["Show Block" hs-show-block "\C-c@\C-s"]
- ["Hide All" hs-hide-all "\C-c@\C-\M-h"]
- ["Show All" hs-show-all "\C-c@\C-\M-s"]
- ["Hide Level" hs-hide-level "\C-c@\C-l"]
- ["Toggle Hiding" hs-toggle-hiding "\C-c@\C-c"]
- [nil hs-mouse-toggle-hiding [(shift mouse-2)]]
- )))))
-
-;; some housekeeping
-(add-to-list 'minor-mode-map-alist (cons 'hs-minor-mode hs-minor-mode-map))
-(add-to-list 'minor-mode-alist '(hs-minor-mode " hs") t)
-
-;; make some variables buffer-local
-(dolist (var '(hs-minor-mode
- hs-c-start-regexp
- hs-block-start-regexp
- hs-block-start-mdata-select
- hs-block-end-regexp
- hs-forward-sexp-func
- hs-adjust-block-beginning))
- (make-variable-buffer-local var))
-
;;---------------------------------------------------------------------------
;; that's it
(provide 'hideshow)
-;;; arch-tag: 378b6852-e82a-466a-aee8-d9c73859a65e
;;; hideshow.el ends here
HCoop / bpt / emacs.git / blobdiff