123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983 |
- (defgroup hideshow nil
- "Minor mode for hiding and showing program and comment blocks."
- :prefix "hs-"
- :group 'languages)
- (defcustom hs-hide-comments-when-hiding-all t
- "*Hide the comments too when you do an `hs-hide-all'."
- :type 'boolean
- :group 'hideshow)
- (defcustom hs-minor-mode-hook nil
- "*Hook called when hideshow minor mode is activated or deactivated."
- :type 'hook
- :group 'hideshow
- :version "21.1")
- (defcustom hs-isearch-open 'code
- "*What kind of hidden blocks to open when doing `isearch'.
- One of the following symbols:
- code -- open only code blocks
- comment -- open only comment blocks
- t -- open both code and comment blocks
- nil -- open neither code nor comment blocks
- This has effect only if `search-invisible' is set to `open'."
- :type '(choice (const :tag "open only code blocks" code)
- (const :tag "open only comment blocks" comment)
- (const :tag "open both code and comment blocks" t)
- (const :tag "don't open any of them" nil))
- :group 'hideshow)
- (defvar hs-special-modes-alist
- (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).
- If non-nil, hideshow will use these values as regexps to define blocks
- and comments, respectively for major mode MODE.
- START, END and COMMENT-START are regular expressions. A block is
- defined as text surrounded by START and END.
- As a special case, START may be a list of the form (COMPLEX-START
- MDATA-SELECTOR), where COMPLEX-START is a regexp w/ multiple parts and
- MDATA-SELECTOR an integer that specifies which sub-match is the proper
- place to adjust point, before calling `hs-forward-sexp-func'. Point
- is adjusted to the beginning of the specified match. For example,
- see the `hs-special-modes-alist' entry for `bibtex-mode'.
- For some major modes, `forward-sexp' does not work properly. In those
- cases, FORWARD-SEXP-FUNC specifies another function to use instead.
- See the documentation for `hs-adjust-block-beginning' to see what is the
- use of ADJUST-BEG-FUNC.
- If any of the elements is left nil or omitted, hideshow tries to guess
- appropriate values. The regexps should not contain leading or trailing
- whitespace. Case does not matter.")
- (defvar hs-hide-all-non-comment-function nil
- "*Function called if non-nil when doing `hs-hide-all' for non-comments.")
- (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.")
- (defvar hs-hide-hook nil
- "*Hook called (with `run-hooks') at the end of commands to hide text.
- These commands include the toggling commands (when the result is to hide
- 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'.")
- (defvar hs-set-up-overlay nil
- "*Function called with one arg, OV, a newly initialized overlay.
- Hideshow puts a unique overlay on each range of text to be hidden
- in the buffer. Here is a simple example of how to use this variable:
- (defun display-code-line-counts (ov)
- (when (eq 'code (overlay-get ov 'hs))
- (overlay-put ov 'display
- (format \"... / %d\"
- (count-lines (overlay-start ov)
- (overlay-end ov))))))
- (setq hs-set-up-overlay 'display-code-line-counts)
- This example shows how to get information from the overlay as well
- as how to set its `display' property. See `hs-make-overlay' and
- info node `(elisp)Overlays'.")
- (defvar hs-minor-mode nil
- "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
- (let ((map (make-sparse-keymap)))
-
- (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.")
- (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.")
- (make-variable-buffer-local 'hs-block-end-regexp)
- (defvar hs-forward-sexp-func 'forward-sexp
- "Function used to do a `forward-sexp'.
- Should change for Algol-ish modes. For single-character block
- delimiters -- ie, the syntax table regexp for the character is
- 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.
- The block is hidden from the position returned by this function,
- as opposed to hiding it from the position returned when searching
- for `hs-block-start-regexp'.
- For example, in c-like modes, if we wish to also hide the curly braces
- \(if you think they occupy too much space on the screen), this function
- should return the starting point (at the end of line) of the hidden
- region.
- It is called with a single argument ARG which is the position in
- buffer after the block beginning.
- It should return the position from where we should start hiding.
- 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.
- You can display this in the mode line by adding the symbol `hs-headline'
- to the variable `mode-line-format'. For example,
- (unless (memq 'hs-headline mode-line-format)
- (setq mode-line-format
- (append '(\"-\" hs-headline) mode-line-format)))
- Note that `mode-line-format' is buffer-local.")
- (defun hs-discard-overlays (from to)
- "Delete hideshow overlays in region defined by FROM and TO.
- Skip \"internal\" overlays if `hs-allow-nesting' is non-nil."
- (when (< to from)
- (setq from (prog1 to (setq to from))))
- (if hs-allow-nesting
- (let (ov)
- (while (> to (setq from (next-overlay-change from)))
- (when (setq ov (hs-overlay-at from))
- (setq from (overlay-end ov))
- (delete-overlay ov))))
- (dolist (ov (overlays-in from to))
- (when (overlay-get ov 'hs)
- (delete-overlay ov)))))
- (defun hs-make-overlay (b e kind &optional b-offset e-offset)
- "Return a new overlay in region defined by B and E with type KIND.
- KIND is either `code' or `comment'. Optional fourth arg B-OFFSET
- when added to B specifies the actual buffer position where the block
- begins. Likewise for optional fifth arg E-OFFSET. If unspecified
- they are taken to be 0 (zero). The following properties are set
- in the overlay: 'invisible 'hs 'hs-b-offset 'hs-e-offset. Also,
- depending on variable `hs-isearch-open', the following properties may
- be present: 'isearch-open-invisible 'isearch-open-invisible-temporary.
- If variable `hs-set-up-overlay' is non-nil it should specify a function
- to call with the newly initialized overlay."
- (unless b-offset (setq b-offset 0))
- (unless e-offset (setq e-offset 0))
- (let ((ov (make-overlay b e))
- (io (if (eq 'block hs-isearch-open)
-
- 'code
- hs-isearch-open)))
- (overlay-put ov 'invisible 'hs)
- (overlay-put ov 'hs kind)
- (overlay-put ov 'hs-b-offset b-offset)
- (overlay-put ov 'hs-e-offset e-offset)
- (when (or (eq io t) (eq io kind))
- (overlay-put ov 'isearch-open-invisible 'hs-isearch-show)
- (overlay-put ov 'isearch-open-invisible-temporary
- 'hs-isearch-show-temporary))
- (when hs-set-up-overlay (funcall hs-set-up-overlay ov))
- ov))
- (defun hs-isearch-show (ov)
- "Delete overlay OV, and set `hs-headline' to nil.
- This function is meant to be used as the `isearch-open-invisible'
- property of an overlay."
- (setq hs-headline nil)
- (delete-overlay ov))
- (defun hs-isearch-show-temporary (ov hide-p)
- "Hide or show overlay OV, and set `hs-headline', all depending on HIDE-P.
- If HIDE-P is non-nil, `hs-headline' is set to nil and overlay OV is hidden.
- Otherwise, `hs-headline' is set to the line of text at the head of OV, and
- OV is shown.
- This function is meant to be used as the `isearch-open-invisible-temporary'
- property of an overlay."
- (setq hs-headline
- (if hide-p
- nil
- (or hs-headline
- (let ((start (overlay-start ov)))
- (buffer-substring
- (save-excursion (goto-char start)
- (beginning-of-line)
- (skip-chars-forward " \t")
- (point))
- start)))))
- (force-mode-line-update)
-
- (let (value)
- (if hide-p
- (when (setq value (overlay-get ov 'hs-isearch-display))
- (overlay-put ov 'display value)
- (overlay-put ov 'hs-isearch-display nil))
- (when (setq value (overlay-get ov 'display))
- (overlay-put ov 'hs-isearch-display value)
- (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."
- (save-match-data
- (set-match-data match-data)
- (goto-char (match-beginning hs-block-start-mdata-select))
- (funcall hs-forward-sexp-func arg)))
- (defun hs-hide-comment-region (beg end &optional repos-end)
- "Hide a region from BEG to END, marking it as a comment.
- Optional arg REPOS-END means reposition at end."
- (let ((beg-eol (progn (goto-char beg) (line-end-position)))
- (end-eol (progn (goto-char end) (line-end-position))))
- (hs-discard-overlays beg-eol end-eol)
- (hs-make-overlay beg-eol end-eol 'comment beg end))
- (goto-char (if repos-end end beg)))
- (defun hs-hide-block-at-point (&optional end comment-reg)
- "Hide block if on block beginning.
- Optional arg END means reposition at end.
- Optional arg COMMENT-REG is a list of the form (BEGIN END) and
- specifies the limits of the comment, or nil if the block is not
- a comment.
- 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 (hs-looking-at-block-start-p)
- (let ((mdata (match-data t))
- (header-end (match-end 0))
- p q ov)
-
-
- (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)))
-
- (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 (- 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.
- Actually, return a list containing the buffer position of the start
- and the end of the comment. A comment block can be hidden only if on
- its starting line there is only whitespace preceding the actual comment
- beginning. If we are inside of a comment but this condition is not met,
- we return a list having a nil as its car and the end of comment position
- as cdr."
- (save-excursion
-
-
-
- (let ((q (point)))
- (skip-chars-forward "[:blank:]")
- (when (or (looking-at hs-c-start-regexp)
- (re-search-backward hs-c-start-regexp (point-min) t))
-
- (while (and (not (bobp))
- (= (point) (progn (forward-comment -1) (point))))
- (forward-char -1))
-
- (forward-comment (- (buffer-size)))
- (skip-chars-forward " \t\n\f")
- (let ((p (point))
- (hidable t))
- (beginning-of-line)
- (unless (looking-at (concat "[ \t]*" hs-c-start-regexp))
-
-
-
-
-
-
-
-
-
- (goto-char p)
- (forward-comment 1)
- (skip-chars-forward " \t\n\f")
- (setq p (point))
- (while (and (< (point) q)
- (> (point) p)
- (not (looking-at hs-c-start-regexp)))
-
- (setq p (point))
- (forward-comment 1)
- (skip-chars-forward " \t\n\f"))
- (when (or (not (looking-at hs-c-start-regexp))
- (> (point) q))
-
- (setq hidable nil)))
-
- (forward-comment (buffer-size))
- (skip-chars-backward " \t\n\f")
- (end-of-line)
- (when (>= (point) q)
- (list (and hidable p) (point))))))))
- (defun hs-grok-mode-type ()
- "Set up hideshow variables for new buffers.
- If `hs-special-modes-alist' has information associated with the
- current buffer's major mode, use that.
- Otherwise, guess start, end and `comment-start' regexps; `forward-sexp'
- function; and adjust-block-beginning function."
- (if (and (boundp 'comment-start)
- (boundp 'comment-end)
- comment-start comment-end)
- (let* ((lookup (assoc major-mode hs-special-modes-alist))
- (start-elem (or (nth 1 lookup) "\\s(")))
- (if (listp start-elem)
-
- (setq hs-block-start-regexp (car start-elem)
- hs-block-start-mdata-select (cadr start-elem))
-
- (setq hs-block-start-regexp start-elem
- hs-block-start-mdata-select 0))
- (setq hs-block-end-regexp (or (nth 2 lookup) "\\s)")
- hs-c-start-regexp (or (nth 3 lookup)
- (let ((c-start-regexp
- (regexp-quote comment-start)))
- (if (string-match " +$" c-start-regexp)
- (substring c-start-regexp
- 0 (1- (match-end 0)))
- c-start-regexp)))
- 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"
- (format-mode-line mode-name))))
- (defun hs-find-block-beginning ()
- "Reposition point at block-start.
- Return point, or nil if original point was not in a block."
- (let ((done nil)
- (here (point)))
-
- (if (hs-looking-at-block-start-p)
- (point)
-
- (while (and (re-search-backward hs-block-start-regexp nil t)
-
- (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)
- nil))))
- (defun hs-hide-level-recursive (arg minp maxp)
- "Recursively hide blocks ARG levels below point in region (MINP MAXP)."
- (when (hs-find-block-beginning)
- (setq minp (1+ (point)))
- (funcall hs-forward-sexp-func 1)
- (setq maxp (1- (point))))
- (unless hs-allow-nesting
- (hs-discard-overlays minp maxp))
- (goto-char minp)
- (while (progn
- (forward-comment (buffer-size))
- (and (< (point) maxp)
- (re-search-forward hs-block-start-regexp maxp t)))
- (when (save-match-data
- (not (nth 8 (syntax-ppss))))
- (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)
- "Evaluate BODY forms if variable `hs-minor-mode' is non-nil.
- In the dynamic context of this macro, `inhibit-point-motion-hooks'
- and `case-fold-search' are both t."
- `(when hs-minor-mode
- (let ((inhibit-point-motion-hooks t)
- (case-fold-search t))
- ,@body)))
- (put 'hs-life-goes-on 'edebug-form-spec '(&rest form))
- (defun hs-overlay-at (position)
- "Return hideshow overlay at POSITION, or nil if none to be found."
- (let ((overlays (overlays-at position))
- ov found)
- (while (and (not found) (setq ov (car overlays)))
- (setq found (and (overlay-get ov 'hs) ov)
- overlays (cdr overlays)))
- found))
- (defun hs-already-hidden-p ()
- "Return non-nil if point is in an already-hidden block, otherwise nil."
- (save-excursion
- (let ((c-reg (hs-inside-comment-p)))
- (if (and c-reg (nth 0 c-reg))
-
- (goto-char (nth 0 c-reg))
- (end-of-line)
- (when (and (not c-reg)
- (hs-find-block-beginning)
- (hs-looking-at-block-start-p))
-
- (goto-char (match-end 0)))))
- (end-of-line)
- (hs-overlay-at (point))))
- (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
- the end of the C-function header. This adjustment function is meant
- to be assigned to `hs-adjust-block-beginning' for C-like modes."
- (save-excursion
- (goto-char (1- initial))
- (forward-comment (- (buffer-size)))
- (point)))
- (defun hs-hide-all ()
- "Hide all top level blocks, displaying only first and last lines.
- Move point to the beginning of the line, and run the normal hook
- `hs-hide-hook'. See documentation for `run-hooks'.
- If `hs-hide-comments-when-hiding-all' is non-nil, also hide the comments."
- (interactive)
- (hs-life-goes-on
- (save-excursion
- (unless hs-allow-nesting
- (hs-discard-overlays (point-min) (point-max)))
- (goto-char (point-min))
- (let ((spew (make-progress-reporter "Hiding all blocks..."
- (point-min) (point-max)))
- (re (concat "\\("
- hs-block-start-regexp
- "\\)"
- (if hs-hide-comments-when-hiding-all
- (concat "\\|\\("
- hs-c-start-regexp
- "\\)")
- ""))))
- (while (progn
- (unless hs-hide-comments-when-hiding-all
- (forward-comment (point-max)))
- (re-search-forward re (point-max) t))
- (if (match-beginning 1)
-
- (progn
- (goto-char (match-beginning 1))
- (if hs-hide-all-non-comment-function
- (funcall hs-hide-all-non-comment-function)
- (hs-hide-block-at-point t)))
-
- (let ((c-reg (hs-inside-comment-p)))
- (when (and c-reg (car c-reg))
- (if (> (count-lines (car c-reg) (nth 1 c-reg)) 1)
- (hs-hide-block-at-point t c-reg)
- (goto-char (nth 1 c-reg))))))
- (progress-reporter-update spew (point)))
- (progress-reporter-done spew)))
- (beginning-of-line)
- (run-hooks 'hs-hide-hook)))
- (defun hs-show-all ()
- "Show everything then run `hs-show-hook'. See `run-hooks'."
- (interactive)
- (hs-life-goes-on
- (message "Showing all blocks ...")
- (let ((hs-allow-nesting nil))
- (hs-discard-overlays (point-min) (point-max)))
- (message "Showing all blocks ... done")
- (run-hooks 'hs-show-hook)))
- (defun hs-hide-block (&optional end)
- "Select a block and hide it. With prefix arg, reposition at END.
- Upon completion, point is repositioned and the normal hook
- `hs-hide-hook' is run. See documentation for `run-hooks'."
- (interactive "P")
- (hs-life-goes-on
- (let ((c-reg (hs-inside-comment-p)))
- (cond
- ((and c-reg (or (null (nth 0 c-reg))
- (<= (count-lines (car c-reg) (nth 1 c-reg)) 1)))
- (message "(not enough comment lines to hide)"))
- ((or c-reg
- (hs-looking-at-block-start-p)
- (hs-find-block-beginning))
- (hs-hide-block-at-point end c-reg)
- (run-hooks 'hs-hide-hook))))))
- (defun hs-show-block (&optional end)
- "Select a block and show it.
- With prefix arg, reposition at END. Upon completion, point is
- repositioned and the normal hook `hs-show-hook' is run.
- See documentation for functions `hs-hide-block' and `run-hooks'."
- (interactive "P")
- (hs-life-goes-on
- (or
-
- (let ((ov (hs-overlay-at (line-end-position)))
- (here (point)))
- (when ov
- (goto-char
- (cond (end (overlay-end ov))
- ((eq 'comment (overlay-get ov 'hs)) here)
- (t (+ (overlay-start ov) (overlay-get ov 'hs-b-offset)))))
- (delete-overlay ov)
- t))
-
- (let ((c-reg (hs-inside-comment-p))
- p q)
- (cond (c-reg
- (when (car c-reg)
- (setq p (car c-reg)
- q (cadr c-reg))))
- ((and (hs-find-block-beginning)
-
- (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)))
- (defun hs-hide-level (arg)
- "Hide all blocks ARG levels below this block.
- The hook `hs-hide-hook' is run; see `run-hooks'."
- (interactive "p")
- (hs-life-goes-on
- (save-excursion
- (message "Hiding blocks ...")
- (hs-hide-level-recursive arg (point-min) (point-max))
- (message "Hiding blocks ... done"))
- (run-hooks 'hs-hide-hook)))
- (defun hs-toggle-hiding ()
- "Toggle hiding/showing of a block.
- See `hs-hide-block' and `hs-show-block'."
- (interactive)
- (hs-life-goes-on
- (if (hs-already-hidden-p)
- (hs-show-block)
- (hs-hide-block))))
- (defun hs-mouse-toggle-hiding (e)
- "Toggle hiding/showing of a block.
- This command should be bound to a mouse key.
- Argument E is a mouse event used by `mouse-set-point'.
- See `hs-hide-block' and `hs-show-block'."
- (interactive "@e")
- (hs-life-goes-on
- (mouse-set-point e)
- (hs-toggle-hiding)))
- (defun hs-hide-initial-comment-block ()
- "Hide the first block of comments in a file.
- This can be useful if you have huge RCS logs in those comments."
- (interactive)
- (hs-life-goes-on
- (let ((c-reg (save-excursion
- (goto-char (point-min))
- (skip-chars-forward " \t\n\f")
- (hs-inside-comment-p))))
- (when c-reg
- (let ((beg (car c-reg)) (end (cadr c-reg)))
-
- (when (> (count-lines beg end) 1)
- (hs-hide-comment-region beg end)))))))
- (define-minor-mode hs-minor-mode
- "Minor mode to selectively hide/show code and comment blocks.
- With a prefix argument ARG, enable the mode if ARG is positive,
- and disable it otherwise. If called from Lisp, enable the mode
- if ARG is omitted or nil.
- 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'.
- The main commands are: `hs-hide-all', `hs-show-all', `hs-hide-block',
- `hs-show-block', `hs-hide-level' and `hs-toggle-hiding'. There is also
- `hs-hide-initial-comment-block' and `hs-mouse-toggle-hiding'.
- Turning hideshow minor mode off reverts the menu bar and the
- variables to default values and disables the hideshow commands.
- Lastly, the normal hook `hs-minor-mode-hook' is run using `run-hooks'.
- Key bindings:
- \\{hs-minor-mode-map}"
- :group 'hideshow
- :lighter " hs"
- :keymap hs-minor-mode-map
- (setq hs-headline nil)
- (if hs-minor-mode
- (progn
- (hs-grok-mode-type)
-
- (add-hook 'change-major-mode-hook
- 'turn-off-hideshow
- nil t)
- (easy-menu-add hs-minor-mode-menu)
- (set (make-local-variable 'line-move-ignore-invisible) t)
- (add-to-invisibility-spec '(hs . t)))
- (remove-from-invisibility-spec '(hs . t))
-
- (let ((hs-minor-mode t))
- (hs-show-all))))
- (defun turn-off-hideshow ()
- "Unconditionally turn off `hs-minor-mode'."
- (hs-minor-mode -1))
- (provide 'hideshow)
|