diff --git a/etc/NEWS b/etc/NEWS index d7c750143cc..64b3e1ca87e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1113,6 +1113,12 @@ blocks. *** New command 'hs-toggle-all'. This command hides or shows all the blocks in the current buffer. +--- +*** 'hs-hide-level' no longer hide all the blocks in the current buffer. +If 'hs-hide-level' was not inside a code block it would hide all the +blocks in the buffer like 'hs-hide-all'. Now it should only hide all +the second level blocks. + +++ *** New user option 'hs-display-lines-hidden'. If this option is non-nil, Hideshow displays the number of hidden lines @@ -1155,7 +1161,7 @@ after cursor position. By default this is set to 'after-bol'. This user option controls the positions on the headline of hideable blocks where the 'TAB' key cycles the blocks' visibility. -+++ +--- *** The variable 'hs-special-modes-alist' is now obsolete. Instead of customizing Hideshow for a mode by setting the elements of 'hs-special-modes-alist', such as START, COMMENT-START, diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index e916d2091c5..886bd7505aa 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -1,12 +1,12 @@ -;;; hideshow.el --- minor mode cmds to selectively display code/comment blocks -*- lexical-binding:t -*- +;;; hideshow.el --- Minor mode to hide/show comment or code blocks -*- lexical-binding:t -*- ;; Copyright (C) 1994-2025 Free Software Foundation, Inc. ;; Author: Thien-Thi Nguyen ;; Dan Nicolaescu -;; Keywords: C C++ java lisp tools editing comments blocks hiding outlines -;; Maintainer-Version: 5.65.2.2 -;; Time-of-Day-Author-Most-Likely-to-be-Recalcitrant: early morning +;; Maintainer: emacs-devel@gnu.org +;; Keywords: c tools outlines +;; Maintainer-Version: 6.0 ;; This file is part of GNU Emacs. @@ -27,17 +27,16 @@ ;; * Commands provided ;; -;; This file provides the Hideshow minor mode. When active, nine commands -;; are available, implementing block hiding and showing. They (and their -;; keybindings) are: +;; This file provides the Hideshow minor mode, it includes the +;; following commands (and their keybindings) to hiding and showing +;; code and comment blocks: ;; -;; `hs-hide-block' C-c @ C-h +;; `hs-hide-block' C-c @ C-h/C-d ;; `hs-show-block' C-c @ C-s -;; `hs-hide-all' C-c @ C-M-h -;; `hs-show-all' C-c @ C-M-s +;; `hs-hide-all' C-c @ C-M-h/C-t +;; `hs-show-all' C-c @ C-M-s/C-a ;; `hs-hide-level' C-c @ C-l -;; `hs-toggle-hiding' C-c @ C-c -;; `hs-toggle-hiding' S- +;; `hs-toggle-hiding' C-c @ C-c/C-e or S- ;; `hs-hide-initial-comment-block' ;; `hs-cycle' C-c @ TAB ;; `hs-toggle-all' C-c @ @@ -45,13 +44,14 @@ ;; All these commands are defined in `hs-prefix-map', ;; `hs-minor-mode-map' and `hs-indicators-map'. ;; -;; Blocks are defined per mode. In c-mode, c++-mode and java-mode, they -;; are simply text between curly braces, while in Lisp-ish modes parens -;; are used. Multi-line comment blocks can also be hidden. Read-only -;; buffers are not a problem, since hideshow doesn't modify the text. +;; Blocks are defined per mode. For example, in c-mode and similar, +;; they are simply text between curly braces, while in Lisp-ish modes +;; parens are used. Multi-line comment blocks can also be hidden. +;; Read-only buffers are not a problem, since hideshow doesn't modify +;; the text. ;; ;; The command `M-x hs-minor-mode' toggles the minor mode or sets it -;; (similar to other minor modes). +;; buffer-local. ;; * Suggested usage ;; @@ -60,6 +60,9 @@ ;; (require 'hideshow) ;; (add-hook 'X-mode-hook #'hs-minor-mode) ; other modes similarly ;; +;; ;; For use-package users: +;; (use-package hideshow :hook (X-mode . hs-minor-mode)) +;; ;; where X = {emacs-lisp,c,c++,perl,...}. You can also manually toggle ;; hideshow minor mode by typing `M-x hs-minor-mode'. After hideshow is ;; activated or deactivated, `hs-minor-mode-hook' is run with `run-hooks'. @@ -78,40 +81,46 @@ ;; (if my-hs-hide ;; (hs-hide-all) ;; (hs-show-all))) -;; -;; [Your hideshow hacks here!] ;; * Customization ;; -;; You can use `M-x customize-variable' on the following variables: +;; Hideshow provides the following user options: ;; -;; - `hs-hide-comments-when-hiding-all' -- self-explanatory! -;; - `hs-hide-all-non-comment-function' -- if non-nil, when doing a -;; `hs-hide-all', this function -;; is called with no arguments -;; - `hs-isearch-open' -- what kind of hidden blocks to -;; open when doing isearch -;; - `hs-display-lines-hidden' -- displays the number of hidden -;; lines next to the ellipsis. -;; - `hs-show-indicators' -- display indicators to show -;; and toggle the block hiding. -;; - `hs-indicator-type' -- which indicator type should be -;; used for the block indicators. -;; - `hs-indicator-maximum-buffer-size' -- max buffer size in bytes where -;; the indicators should be enabled. +;; - `hs-hide-comments-when-hiding-all' +;; self-explanatory! +;; - `hs-hide-all-non-comment-function' +;; If non-nil, after calling `hs-hide-all', this function is called +;; with no arguments. +;; - `hs-isearch-open' +;; What kind of hidden blocks to open when doing isearch. +;; - `hs-set-up-overlay' +;; Function called with one arg (an overlay), intended to customize +;; the block hiding appearance. +;; - `hs-display-lines-hidden' +;; Displays the number of hidden lines next to the ellipsis. +;; - `hs-show-indicators' +;; Display indicators to show and toggle the block hiding. +;; - `hs-indicator-type' +;; Which indicator type should be used for the block indicators. +;; - `hs-indicator-maximum-buffer-size' +;; Max buffer size in bytes where the indicators should be enabled. +;; - `hs-allow-nesting' +;; If non-nil, hiding remembers internal blocks. +;; - `hs-cycle-filter' +;; Control where typing a `TAB' cycles the visibility. ;; -;; Some languages (e.g., Java) are deeply nested, so the normal behavior -;; of `hs-hide-all' (hiding all but top-level blocks) results in very -;; little information shown, which is not very useful. You can use the -;; variable `hs-hide-all-non-comment-function' to implement your idea of -;; what is more useful. For example, the following code shows the next -;; nested level in addition to the top-level: +;; The variable `hs-hide-all-non-comment-function' may be useful if you +;; only want to hide some N levels blocks for some languages/files or +;; implement your idea of what is more useful. For example, the +;; following code shows the next nested level in addition to the +;; top-level for java: ;; -;; (defun ttn-hs-hide-level-1 () +;; (defun ttn-hs-hide-level-2 () ;; (when (funcall hs-looking-at-block-start-predicate) -;; (hs-hide-level 1)) -;; (forward-sexp 1)) -;; (setq hs-hide-all-non-comment-function 'ttn-hs-hide-level-1) +;; (hs-hide-level 2))) +;; (setq-mode-local java-mode ; This requires the mode-local package +;; hs-hide-all-non-comment-function +;; 'ttn-hs-hide-level-2) ;; ;; Hideshow works with incremental search (isearch) by setting the variable ;; `hs-headline', which is the line of text at the beginning of a hidden @@ -123,30 +132,25 @@ ;; (setq mode-line-format ;; (append '("-" hs-headline) mode-line-format))) ;; -;; See documentation for `mode-line-format' for more info. ;; -;; Hooks are run after some commands: +;; The following hooks are run after some commands: ;; -;; hs-hide-hook in hs-hide-block, hs-hide-all, hs-hide-level -;; hs-show-hook hs-show-block, hs-show-all +;; hs-hide-hook => hs-hide-block hs-hide-all hs-hide-level hs-cycle +;; hs-show-hook => hs-show-block hs-show-all hs-cycle ;; -;; One of `hs-hide-hook' or `hs-show-hook' is run for the toggling -;; commands when the result of the toggle is to hide or show blocks, -;; respectively. All hooks are run with `run-hooks'. See the -;; documentation for each variable or hook for more information. +;; The variable `hs-set-up-overlay' allow customize the appearance of +;; the hidden block and other effects associated with overlays. For +;; example: ;; -;; See also variable `hs-set-up-overlay' for per-block customization of -;; appearance or other effects associated with overlays. For example: -;; -;; (setq hs-set-up-overlay -;; (defun my-display-code-line-counts (ov) -;; (when (eq 'code (overlay-get ov 'hs)) -;; (overlay-put ov 'display -;; (propertize -;; (format " ... <%d>" -;; (count-lines (overlay-start ov) -;; (overlay-end ov))) -;; 'face 'font-lock-type-face))))) +;; (setopt hs-set-up-overlay +;; (defun my-display-code-line-counts (ov) +;; (when (eq 'code (overlay-get ov 'hs)) +;; (overlay-put ov 'display +;; (propertize +;; (format " [... <%d>] " +;; (count-lines (overlay-start ov) +;; (overlay-end ov))) +;; 'face 'font-lock-type-face))))) ;; * Extending hideshow @@ -207,45 +211,39 @@ ;; * Bugs ;; -;; (1) Sometimes `hs-headline' can become out of sync. To reset, type -;; `M-x hs-minor-mode' twice (that is, deactivate then re-activate -;; hideshow). +;; 1) Sometimes `hs-headline' can become out of sync. To reset, type +;; `M-x hs-minor-mode' twice (that is, deactivate then re-activate +;; hideshow). ;; -;; (2) Some buffers can't be `byte-compile-file'd properly. This is because -;; `byte-compile-file' inserts the file to be compiled in a temporary -;; buffer and switches `normal-mode' on. In the case where you have -;; `hs-hide-initial-comment-block' in `hs-minor-mode-hook', the hiding of -;; the initial comment sometimes hides parts of the first statement (seems -;; to be only in `normal-mode'), so there are unbalanced "(" and ")". +;; 2) Some buffers can't be `byte-compile-file'd properly. This is because +;; `byte-compile-file' inserts the file to be compiled in a temporary +;; buffer and switches `normal-mode' on. In the case where you have +;; `hs-hide-initial-comment-block' in `hs-minor-mode-hook', the hiding of +;; the initial comment sometimes hides parts of the first statement (seems +;; to be only in `normal-mode'), so there are unbalanced parenthesis. ;; -;; The workaround is to clear `hs-minor-mode-hook' when byte-compiling: +;; The workaround is to clear `hs-minor-mode-hook' when byte-compiling: ;; -;; (defadvice byte-compile-file (around -;; byte-compile-file-hideshow-off -;; act) -;; (let ((hs-minor-mode-hook nil)) -;; ad-do-it)) +;; (define-advice byte-compile-file (:around +;; (fn &rest rest) +;; byte-compile-file-hideshow-off) +;; (let (hs-minor-mode-hook) +;; (apply #'fn rest))) ;; -;; (3) Hideshow interacts badly with Ediff and `vc-diff'. At the moment, the -;; suggested workaround is to turn off hideshow entirely, for example: +;; 3) Hideshow interacts badly with Ediff and `vc-diff'. At the moment, the +;; suggested workaround is to turn off hideshow entirely, for example: ;; -;; (add-hook 'ediff-prepare-buffer-hook #'turn-off-hideshow) -;; (add-hook 'vc-before-checkin-hook #'turn-off-hideshow) +;; (add-hook 'ediff-prepare-buffer-hook #'turn-off-hideshow) +;; (add-hook 'vc-before-checkin-hook #'turn-off-hideshow) ;; -;; In the case of `vc-diff', here is a less invasive workaround: +;; In the case of `vc-diff', here is a less invasive workaround: ;; -;; (add-hook 'vc-before-checkin-hook -;; (lambda () -;; (goto-char (point-min)) -;; (hs-show-block))) +;; (add-hook 'vc-before-checkin-hook +;; (lambda () +;; (goto-char (point-min)) +;; (hs-show-block))) ;; -;; Unfortunately, these workarounds do not restore hideshow state. -;; If someone figures out a better way, please let me know. - -;; * Correspondence -;; -;; Correspondence welcome; please indicate version number. Send bug -;; reports and inquiries to . +;; Unfortunately, these workarounds do not restore hideshow state. ;; * Thanks ;; @@ -264,7 +262,7 @@ ;; mouse support, and maintained the code in general. Version 4.0 is ;; largely due to his efforts. -;; * History +;; * History (author commentary) ;; ;; Hideshow was inspired when I learned about selective display. It was ;; reimplemented to use overlays for 4.0 (see above). WRT older history, @@ -276,19 +274,23 @@ ;; unbundles state save and restore, and includes more isearch support. ;;; Code: + + +;;;; Libraries + (require 'mule-util) ; For `truncate-string-ellipsis' ;; For indicators (require 'icons) (require 'fringe) -;;--------------------------------------------------------------------------- -;; user-configurable variables - + (defgroup hideshow nil "Minor mode for hiding and showing program and comment blocks." :prefix "hs-" :group 'languages) +;;;; Faces + (defface hs-ellipsis '((t :height 0.80 :box (:line-width -1) :inherit (shadow default))) "Face used for hideshow ellipsis. @@ -306,6 +308,22 @@ use that face for the ellipsis instead." "Face used in hideshow indicator to indicate a shown block." :version "31.1") +;;;; Options + +(defcustom 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'." + :type 'hook + :version "31.1") + +(defcustom 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'." + :type 'hook + :version "31.1") + (defcustom hs-hide-comments-when-hiding-all t "Hide the comments too when you do an `hs-hide-all'." :type 'boolean) @@ -385,54 +403,6 @@ size." :type '(choice natnum (const :tag "No limit" nil)) :version "31.1") -(define-fringe-bitmap - 'hs-hide - [#b0000000 - #b1000001 - #b1100011 - #b0110110 - #b0011100 - #b0001000 - #b0000000]) - -(define-fringe-bitmap - 'hs-show - [#b0110000 - #b0011000 - #b0001100 - #b0000110 - #b0001100 - #b0011000 - #b0110000]) - -(define-icon hs-indicator-hide nil - `((image "outline-open.svg" "outline-open.pbm" - :face hs-indicator-hide - :height (0.6 . em) - :ascent center) - (symbol "▾" "▼" :face hs-indicator-hide) - (text "-" :face hs-indicator-hide)) - "Icon used for hide block at point. -This is only used if `hs-indicator-type' is set to `margin' or nil." - :version "31.1") - -(define-icon hs-indicator-show nil - `((image "outline-close.svg" "outline-close.pbm" - :face hs-indicator-show - :height (0.6 . em) - :ascent center) - (symbol "▸" "▶" :face hs-indicator-show) - (text "+" :face hs-indicator-show)) - "Icon used for show block at point. -This is only used if `hs-indicator-type' is set to `margin' or nil." - :version "31.1") - -;;;###autoload -(defvar hs-special-modes-alist nil) -(make-obsolete-variable 'hs-special-modes-alist - "use the buffer-local variables instead" - "31.1") - (defcustom hs-allow-nesting nil "If non-nil, hiding remembers internal blocks. This means that when the outer block is shown again, @@ -440,16 +410,6 @@ any previously hidden internal blocks remain hidden." :type 'boolean :version "31.1") -(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'.") - (defcustom hs-set-up-overlay #'ignore "Function called with one arg, OV, a newly initialized overlay. Hideshow puts a unique overlay on each range of text to be hidden @@ -495,12 +455,52 @@ major mode, elsewhere on the headlines." (function :tag "Custom filter function")) :version "31.1") -;;--------------------------------------------------------------------------- -;; internal variables +;;;; Icons -(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.") +(define-icon hs-indicator-hide nil + `((image "outline-open.svg" "outline-open.pbm" + :face hs-indicator-hide + :height (0.6 . em) + :ascent center) + (symbol "▾" "▼" :face hs-indicator-hide) + (text "-" :face hs-indicator-hide)) + "Icon used for hide block at point. +This is only used if `hs-indicator-type' is set to `margin' or nil." + :version "31.1") + +(define-icon hs-indicator-show nil + `((image "outline-close.svg" "outline-close.pbm" + :face hs-indicator-show + :height (0.6 . em) + :ascent center) + (symbol "▸" "▶" :face hs-indicator-show) + (text "+" :face hs-indicator-show)) + "Icon used for show block at point. +This is only used if `hs-indicator-type' is set to `margin' or nil." + :version "31.1") + +(define-fringe-bitmap + 'hs-hide + [#b0000000 + #b1000001 + #b1100011 + #b0110110 + #b0011100 + #b0001000 + #b0000000]) + +(define-fringe-bitmap + 'hs-show + [#b0110000 + #b0011000 + #b0001100 + #b0000110 + #b0001100 + #b0011000 + #b0110000]) + + +;;;; Keymaps (defvar-keymap hs-prefix-map :doc "Keymap for hideshow commands." @@ -530,8 +530,8 @@ Use the command `hs-minor-mode' to toggle or set this variable.") (when (and hs-cycle-filter ;; On the headline with hideable blocks (save-excursion - (goto-char (line-beginning-position)) - (hs-get-first-block)) + (forward-line 0) + (hs-get-first-block-on-line)) (or (not (functionp hs-cycle-filter)) (funcall hs-cycle-filter))) cmd))) @@ -563,7 +563,7 @@ Use the command `hs-minor-mode' to toggle or set this variable.") (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" + ("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)] @@ -579,13 +579,18 @@ Show both hidden code and comment blocks when isearch matches inside them" Do not show hidden code or comment blocks when isearch matches inside them" :active t :style radio :selected (eq hs-isearch-open nil)]))) + +;;;; Internal variables + +(defvar hs-minor-mode) + (defvar hs-hide-all-non-comment-function nil "Function called if non-nil when doing `hs-hide-all' for non-comments.") (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, +to the variable `mode-line-format'. For example: (unless (memq \\='hs-headline mode-line-format) (setq mode-line-format @@ -593,21 +598,32 @@ to the variable `mode-line-format'. For example, Note that `mode-line-format' is buffer-local.") +;; Used in `hs-toggle-all' (defvar-local hs--toggle-all-state) -;;--------------------------------------------------------------------------- -;; API variables + +;;;; API variables + +;;;###autoload +(defvar hs-special-modes-alist nil) +(make-obsolete-variable + 'hs-special-modes-alist + "use the buffer-local variables instead" "31.1") (defvar-local hs-block-start-regexp "\\s(" "Regexp for beginning of block.") +;; This is useless, so probably should be deprecated. (defvar-local hs-block-start-mdata-select 0 "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-function'.") (defvar-local hs-block-end-regexp "\\s)" - "Regexp for end of block.") + "Regexp for end of block. +As a special case, the value can be also a function without arguments to +determine if point is looking at the end of the block, and return +non-nil and set `match-data' to that block end positions.") (defvar-local hs-c-start-regexp nil "Regexp for beginning of comments. @@ -619,46 +635,35 @@ any trailing whitespace.") (define-obsolete-variable-alias 'hs-forward-sexp-func - 'hs-forward-sexp-function - "31.1") + 'hs-forward-sexp-function "31.1") (defvar-local hs-forward-sexp-function #'forward-sexp "Function used to do a `forward-sexp'. +It is called with 1 argument (like `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-function' would just be +delimiters such as `(' and `)' `hs-forward-sexp-function' would just be `forward-sexp'. For other modes such as simula, a more specialized function is necessary.") (define-obsolete-variable-alias 'hs-adjust-block-beginning - 'hs-adjust-block-beginning-function - "31.1") + 'hs-adjust-block-beginning-function "31.1") (defvar-local hs-adjust-block-beginning-function 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 should return the position from where we should start hiding, as +opposed to hiding it from the position returned when searching for +`hs-block-start-regexp'. 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.") +buffer after the block beginning.") (defvar-local hs-adjust-block-end-function nil "Function used to tweak the block end. This is useful to ensure some characters such as parenthesis or curly -braces get properly hidden in python-like modes. +braces get properly hidden in modes without parenthesis pairs +delimiters (such as python). It is called with one argument, which is the start position where the overlay will be created, and should return either the last position to @@ -669,7 +674,8 @@ hide or nil. If it returns nil, hideshow will guess the end position.") 'hs-find-block-beginning-function "31.1") -(defvar-local hs-find-block-beginning-function #'hs-find-block-beginning +(defvar-local hs-find-block-beginning-function + #'hs-find-block-beg-fn--default "Function used to do `hs-find-block-beginning'. It should reposition point at the beginning of the current block and return point, or nil if original point was not in a block. @@ -683,30 +689,32 @@ to find the beginning of the current block.") 'hs-find-next-block-function "31.1") -(defvar-local hs-find-next-block-function #'hs-find-next-block +(defvar-local hs-find-next-block-function + #'hs-find-next-block-fn--default "Function used to do `hs-find-next-block'. It should reposition point at next block start. -It is called with three arguments REGEXP, MAXP, and COMMENTS. -REGEXP is a regexp representing block start. When block start is -found, `match-data' should be set using REGEXP. MAXP is a buffer -position that limits the search. When COMMENTS is nil, comments -should be skipped. When COMMENTS is not nil, REGEXP matches not -only beginning of a block but also beginning of a comment. In -this case, the function should find nearest block or comment. +It is called with three arguments REGEXP, BOUND, and COMMENTS. +REGEXP is a regexp representing block start. When block start is found, +`match-data' should be set using REGEXP. BOUND is a buffer position +that limits the search. When COMMENTS is non-nil, REGEXP matches not +only beginning of a block but also beginning of a comment. In this +case, the function should find nearest block or comment. -Specifying this function is necessary for languages such as -Python, where regexp search is not enough to find the beginning -of the next block.") +Specifying this function is necessary for languages such as Python, +where regexp search is not enough to find the beginning of the next +block.") (define-obsolete-variable-alias 'hs-looking-at-block-start-p-func 'hs-looking-at-block-start-predicate "31.1") -(defvar-local hs-looking-at-block-start-predicate #'hs-looking-at-block-start-p +(defvar-local hs-looking-at-block-start-predicate + #'hs-looking-at-block-start-p--default "Function used to do `hs-looking-at-block-start-p'. -It should return non-nil if the point is at the block start. +It should return non-nil if the point is at the block start and set +match data with the beginning and end of that position. Specifying this function is necessary for languages such as Python, where `looking-at' and `syntax-ppss' check is not enough @@ -716,47 +724,232 @@ to check if the point is at the block start.") "Function used to check if point is inside a comment. If point is inside a comment, the function should return a list containing the buffer position of the start and the end of the -comment, otherwise it should return nil. - -A comment block can be hidden only if on its starting line there is only -whitespace preceding the actual comment beginning. If point is inside -a comment but this condition is not met, the function can return a list -having nil as its `car' and the end of comment position as its `cdr'.") +comment, otherwise it should return nil.") (defvar-local hs-treesit-things 'list "Treesit things to check if point is at a valid block. The value should be a thing defined in `treesit-thing-settings' for the current buffer's major mode.") -;;--------------------------------------------------------------------------- -;; support functions + +;;;; API functions -(defun hs-discard-overlays (from to) - "Delete hideshow overlays in region defined by FROM and TO. +(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, `case-fold-search' is t. + +This macro encloses BODY in `save-match-data' and `save-excursion'. + +Intended to be used for commands." + (declare (debug t)) + `(when hs-minor-mode + (let ((case-fold-search t)) + (save-match-data + (save-excursion ,@body))))) + +(defun hs-discard-overlays (beg end) + "Delete hideshow overlays in region defined by BEG and END. Skip \"internal\" overlays if `hs-allow-nesting' is non-nil." - (when (< to from) - (setq from (prog1 to (setq to from)))) + (when (< end beg) + (setq beg (prog1 end (setq end beg)))) (if hs-allow-nesting - (let ((from from) ov) - (while (> to (setq from (next-overlay-change from))) - (when (setq ov (hs-overlay-at from)) - (setq from (overlay-end ov)) + (let ((beg beg)) + (while (> end (setq beg (next-overlay-change beg))) + (when-let* ((ov (hs-overlay-at beg))) + ;; Reposition point to the end of the overlay, so we avoid + ;; removing the nested overlays too. + (setq beg (overlay-end ov)) (delete-overlay ov)))) - (dolist (ov (overlays-in from to)) - (when (overlay-get ov 'hs) - (delete-overlay ov)))) - (hs--refresh-indicators from to)) + (remove-overlays beg end 'invisible 'hs)) + (hs--refresh-indicators beg end)) -(defun hs-hideable-region-p (&optional beg end) - "Return t if region between BEG and END can be hidden. -If BEG and END are not specified, try to check the current -block at point." +(defun hs-overlay-at (position) + "Return hideshow overlay at POSITION, or nil if none to be found." + (seq-find + (lambda (ov) (overlay-get ov 'hs)) + (overlays-at position))) + +(defun hs-hideable-region-p (beg end) + "Return t if region between BEG and END can be hidden." ;; Check if BEG and END are not in the same line number, ;; since using `count-lines' is slow. - (if (and beg end) - (< beg (save-excursion (goto-char end) (line-beginning-position))) - (when-let* ((block (hs-block-positions))) - (apply #'hs-hideable-region-p block)))) + (and beg end + (< beg (save-excursion (goto-char end) (pos-bol))))) + +(defun hs-already-hidden-p () + "Return non-nil if point is in an already-hidden block, otherwise nil." + (save-excursion + ;; Reposition point if it is inside a comment, and if that comment + ;; is hideable + (when-let* ((c-reg (funcall hs-inside-comment-predicate))) + (goto-char (car c-reg))) + ;; Search for a hidden block at EOL ... + (eq 'hs + (or (get-char-property (pos-eol) 'invisible) + ;; ... or behind the current cursor position + (get-char-property (if (bobp) (point) (1- (point))) + 'invisible))))) + +(defun hs-block-positions (&optional adjust-beg adjust-end) + "Return the current code block positions. +This returns a list with the current code block beginning and end +positions. This does nothing if there is not a code block at current +point. + +If either ADJUST-BEG or ADJUST-END are non-nil, adjust block positions +according to `hs-adjust-block-beginning', `hs-adjust-block-end-function' +and `hs-block-end-regexp'." + ;; `catch' is used here if the search fails due unbalanced parentheses + ;; or any other unknown error caused in `hs-forward-sexp-function'. + (catch 'hs--block-exit + (save-match-data + (save-excursion + (when (funcall hs-looking-at-block-start-predicate) + (let ((beg (match-end 0)) end) + ;; `beg' is the point at the end of the block + ;; beginning, which may need to be adjusted + (when adjust-beg + (save-excursion + (when hs-adjust-block-beginning-function + (goto-char (funcall hs-adjust-block-beginning-function beg))) + (setq beg (pos-eol)))) + + (goto-char (match-beginning hs-block-start-mdata-select)) + (condition-case _ + (funcall hs-forward-sexp-function 1) + (scan-error (throw 'hs-sexp-error nil))) + ;; `end' is the point at the end of the block + (setq end (cond ((not adjust-end) (point)) + ((and (stringp hs-block-end-regexp) + (looking-back hs-block-end-regexp nil)) + (match-beginning 0)) + ((functionp hs-block-end-regexp) + (funcall hs-block-end-regexp) + (match-beginning 0)) + (t (point)))) + ;; adjust block end (if needed) + (when (and adjust-end hs-adjust-block-end-function) + (setq end (or (funcall hs-adjust-block-end-function beg) + end))) + (list beg end))))))) + +(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." + (declare (obsolete "Use `hs-hide-block-at-point' instead." "31.1")) + (hs-hide-block-at-point (list beg end))) + +(defun hs-hide-block-at-point (&optional comment-reg) + "Hide block if on block beginning. +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. + +If hiding the block is successful, return non-nil. +Otherwise, return nil." + (when-let* ((block (or comment-reg (hs-block-positions :a-beg :a-end)))) + (let ((beg (if comment-reg (save-excursion (goto-char (car block)) (pos-eol)) + (car block))) + (end (cadr block)) + ov) + (if (hs-hideable-region-p beg end) + (progn + (cond (comment-reg (let (hs-allow-nesting) + (hs-discard-overlays beg end))) + ((and hs-allow-nesting (setq ov (hs-overlay-at beg))) + (delete-overlay ov)) + ((not hs-allow-nesting) + (hs-discard-overlays beg end))) + (goto-char end) + (hs-make-overlay beg end (if comment-reg 'comment 'code))) + (when comment-reg (goto-char end)) + nil)))) + +(defun hs-get-first-block-on-line (&optional include-comments) + "Reposition point to the first valid block found on the current line. +This searches for a valid block from current point to the end of current +line and returns the start position of the first block found. +Otherwise, if no block is found, it returns nil. + +If INCLUDE-COMMENTS is non-nil, also search for a comment block." + (let ((regexp (if include-comments + (concat "\\(" hs-block-start-regexp "\\)" + "\\|\\(" hs-c-start-regexp "\\)") + hs-block-start-regexp)) + exit) + (while (and (not exit) + (funcall hs-find-next-block-function regexp (pos-eol) include-comments) + (save-excursion + (goto-char (match-beginning 0)) + (pcase-let ((`(,beg ,end) + (or (and include-comments + (funcall hs-inside-comment-predicate)) + (hs-block-positions)))) + (if (and beg (hs-hideable-region-p beg end)) + (setq exit (point)) + t))))) + exit)) + +(defun hs-get-near-block (&optional include-comment) + "Reposition point to a near block around point. +It search for a valid block before and after point and return t if one +is found. + +If INCLUDE-COMMENT is non-nil, it also searches for a comment block, +returning `comment' if one is found. + +Intended to be used in commands." + (let ((c-reg (when include-comment (funcall hs-inside-comment-predicate))) + pos) + (cond + ((and c-reg (apply #'hs-hideable-region-p c-reg)) + (goto-char (car c-reg)) + 'comment) + + ((and (eq hs-hide-block-behavior 'after-bol) + (save-excursion + (forward-line 0) + (setq pos (hs-get-first-block-on-line)))) + (goto-char pos) + t) + + ((and (or (funcall hs-looking-at-block-start-predicate) + (and (forward-line 0) + (funcall hs-find-block-beginning-function))) + (apply #'hs-hideable-region-p (hs-block-positions))) + t)))) + +(defun hs-hide-level-recursive (arg beg end &optional include-comments func progress) + "Recursively hide blocks between BEG and END that are ARG levels below point. +If INCLUDE-COMMENTS is non-nil, also hide recursive comment blocks. If +FUNC is non-nil, call this function to hide the block instead. If +PROGRESS is non-nil, also update a progress object, intended for +commands." + ;; Show all blocks in that region + (unless hs-allow-nesting (hs-discard-overlays beg end)) + (goto-char beg) + (while (not (>= (point) end)) + (when-let* ((_ (not (invisible-p (point)))) ; Skip invisible lines + (block (save-excursion + (hs-get-first-block-on-line include-comments)))) + (goto-char (match-beginning 0)) + (if (> arg 1) + ;; Find a block recursively according to ARG. + (pcase-let ((`(,beg ,end) (or (and include-comments + (funcall hs-inside-comment-predicate)) + (hs-block-positions)))) + (hs-hide-level-recursive (1- arg) beg end include-comments)) + ;; Now hide the block we found. + (if func (funcall func) + (hs-hide-block-at-point + (and include-comments (funcall hs-inside-comment-predicate)))) + (when progress + (progress-reporter-update progress (point))))) + (forward-line 1)) + (goto-char end)) + + +;;;; Internal functions (defun hs--discard-overlay-before-changes (o &rest _r) "Remove overlay O before changes. @@ -767,19 +960,49 @@ Intended to be used in `modification-hooks', `insert-in-front-hooks' and (delete-overlay o) (hs--refresh-indicators beg end))) -(defun hs-make-overlay (b e kind &optional b-offset e-offset) +(defun hs--get-ellipsis (b e) + "Helper function for `hs-make-overlay'. +This returns the ellipsis string to use and its face." + (let* ((standard-display-table + (or standard-display-table (make-display-table))) + (d-t-ellipsis + (display-table-slot standard-display-table 'selective-display)) + ;; Convert ellipsis vector to a propertized string + (ellipsis + (and (vectorp d-t-ellipsis) ; Ensure the vector is not empty + (not (length= d-t-ellipsis 0)) + (mapconcat + (lambda (g) + (apply #'propertize (char-to-string (glyph-char g)) + (and (glyph-face g) (list 'face (glyph-face g))))) + d-t-ellipsis))) + (ellipsis-face (and ellipsis (get-text-property 0 'face ellipsis))) + (apply-face (lambda (str) + (apply #'propertize str + (and ellipsis-face (list 'face ellipsis-face))))) + (lines (when-let* (hs-display-lines-hidden + (l (1- (count-lines b e))) + (l-str (format "%d %s" l + (if (= l 1) "line" "lines")))) + (funcall apply-face l-str))) + (tty-strings (and hs-display-lines-hidden (not (display-graphic-p)))) + (string + (concat (and tty-strings (funcall apply-face "[")) + lines + (or ellipsis (truncate-string-ellipsis)) + (and tty-strings (funcall apply-face "]"))))) + (if ellipsis-face + ;; Return ELLIPSIS and LINES if ELLIPSIS has no face + string + ;; Otherwise propertize both with `hs-ellipsis' + (propertize string 'face 'hs-ellipsis)))) + +(defun hs-make-overlay (b e kind) "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)) +KIND is either `code' or `comment'. The following properties are set in +the overlay: `invisible' `hs'. Also, depending on variable +`hs-isearch-open', the following properties may be present: +`isearch-open-invisible' `isearch-open-invisible-temporary'." (let ((ov (make-overlay b e)) (io (if (eq 'block hs-isearch-open) ;; backward compatibility -- `block'<=>`code' @@ -795,8 +1018,6 @@ to call with the newly initialized overlay." 'keymap '(keymap (mouse-1 . hs-toggle-hiding)))) ;; Internal properties (overlay-put ov 'hs kind) - (overlay-put ov 'hs-b-offset b-offset) - (overlay-put ov 'hs-e-offset e-offset) ;; Isearch integration (when (or (eq io t) (eq io kind)) (overlay-put ov 'isearch-open-invisible 'hs-isearch-show) @@ -808,48 +1029,9 @@ to call with the newly initialized overlay." (overlay-put ov 'insert-behind-hooks '(hs--discard-overlay-before-changes)) (when hs-set-up-overlay (funcall hs-set-up-overlay ov)) - (hs--refresh-indicators b e) + (hs--refresh-indicators b (1+ b)) ov)) -(defun hs-block-positions () - "Return the current code block positions. -This returns a list with the current code block beginning and end -positions. This does nothing if there is not a code block at current -point." - ;; `catch' is used here if the search fails due unbalanced parentheses - ;; or any other unknown error caused in `hs-forward-sexp'. - (catch 'hs-sexp-error - (save-match-data - (save-excursion - (when (funcall hs-looking-at-block-start-predicate) - (let ((mdata (match-data t)) - (header-end (match-end 0)) - block-beg block-end) - ;; `block-start' is the point at the end of the block - ;; beginning, which may need to be adjusted - (save-excursion - (when hs-adjust-block-beginning-function - (goto-char (funcall hs-adjust-block-beginning-function header-end))) - (setq block-beg (line-end-position))) - ;; `block-end' is the point at the end of the block - (condition-case _ - (hs-forward-sexp mdata 1) - (scan-error (throw 'hs-sexp-error nil))) - (setq block-end - (cond ((and (stringp hs-block-end-regexp) - (looking-back hs-block-end-regexp nil)) - (match-beginning 0)) - ((functionp hs-block-end-regexp) - (funcall hs-block-end-regexp) - (match-beginning 0)) - (t (point)))) - ;; adjust block end (if needed) - (when hs-adjust-block-end-function - (setq block-end - (or (funcall hs-adjust-block-end-function block-beg) - block-end))) - (list block-beg block-end))))))) - (defun hs--make-indicators-overlays (beg) "Helper function to make the indicators overlays." (let ((hiddenp (eq 'hs (get-char-property (pos-eol) 'invisible)))) @@ -897,15 +1079,17 @@ point." (defun hs--add-indicators (&optional beg end) "Add hideable indicators from BEG to END." - (save-excursion - (setq beg (if (null beg) (window-start) (goto-char beg) (pos-bol)) - end (if (null end) (window-end) (goto-char end) (pos-bol)))) + (setq beg (progn (goto-char beg) (pos-bol)) + end (progn (goto-char end) + ;; Include the EOL indicator positions + (min (1+ (pos-eol)) (point-max)))) (goto-char beg) (remove-overlays beg end 'hs-indicator t) (while (not (>= (point) end)) (save-excursion - (when-let* ((b-beg (hs-get-first-block))) + (when-let* ((_ (not (invisible-p (point)))) ; Skip invisible lines + (b-beg (hs-get-first-block-on-line))) (hs--make-indicators-overlays b-beg))) ;; Only 1 indicator per line (forward-line)) @@ -918,43 +1102,6 @@ point." (save-excursion (hs--add-indicators from to))))) -(defun hs--get-ellipsis (b e) - "Helper function for `hs-make-overlay'. -This returns the ellipsis string to use and its face." - (let* ((standard-display-table - (or standard-display-table (make-display-table))) - (d-t-ellipsis - (display-table-slot standard-display-table 'selective-display)) - ;; Convert ellipsis vector to a propertized string - (ellipsis - (and (vectorp d-t-ellipsis) ; Ensure the vector is not empty - (not (length= d-t-ellipsis 0)) - (mapconcat - (lambda (g) - (apply #'propertize (char-to-string (glyph-char g)) - (and (glyph-face g) (list 'face (glyph-face g))))) - d-t-ellipsis))) - (ellipsis-face (and ellipsis (get-text-property 0 'face ellipsis))) - (apply-face (lambda (str) - (apply #'propertize str - (and ellipsis-face (list 'face ellipsis-face))))) - (lines (when-let* (hs-display-lines-hidden - (l (1- (count-lines b e))) - (l-str (format "%d %s" l - (if (= l 1) "line" "lines")))) - (funcall apply-face l-str))) - (tty-strings (and hs-display-lines-hidden (not (display-graphic-p)))) - (string - (concat (and tty-strings (funcall apply-face "[")) - lines - (or ellipsis (truncate-string-ellipsis)) - (and tty-strings (funcall apply-face "]"))))) - (if ellipsis-face - ;; Return ELLIPSIS and LINES if ELLIPSIS has no face - string - ;; Otherwise propertize both with `hs-ellipsis' - (propertize string 'face 'hs-ellipsis)))) - (defun hs-isearch-show (ov) "Delete overlay OV, and set `hs-headline' to nil. @@ -972,8 +1119,7 @@ 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 + (unless hide-p (or hs-headline (let ((start (overlay-start ov))) (buffer-substring @@ -990,107 +1136,15 @@ property of an overlay." (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 'display nil) + (overlay-put ov 'hs-isearch-display value)))) (overlay-put ov 'invisible (and hide-p 'hs))) -(defun hs-looking-at-block-start-p () +(defun hs-looking-at-block-start-p--default () "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-function' with 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-function 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 ((goal-col (current-column)) - (beg-bol (progn (goto-char beg) (line-beginning-position))) - (beg-eol (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 (min end (+ beg-bol goal-col)))))) - -(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-function' -and then further adjusted to be at the end of the line. - -If hiding the block is successful, return non-nil. -Otherwise, return nil." - (if comment-reg - (hs-hide-comment-region (car comment-reg) (cadr comment-reg) end) - (when-let* ((block (hs-block-positions))) - (let ((p (car block)) - (q (cadr block)) - ov) - (if (hs-hideable-region-p p q) - (progn - (cond ((and hs-allow-nesting (setq ov (hs-overlay-at p))) - (delete-overlay ov)) - ((not hs-allow-nesting) - (hs-discard-overlays p q))) - (goto-char q) - (hs-make-overlay p q 'code (- (match-end 0) p))) - (goto-char (if end q (min p (match-end 0)))) - nil))))) - -(defun hs-get-first-block () - "Return the position of the first valid block found on the current line. -This searches for a valid block on the current line and returns the -first block found. Otherwise, if no block is found, it returns nil." - (let (exit) - (while (and (not exit) - (funcall hs-find-next-block-function - hs-block-start-regexp - (line-end-position) nil) - (save-excursion - (goto-char (match-beginning 0)) - (if (hs-hideable-region-p) - (setq exit (match-beginning 0)) - t)))) - exit)) - -(defun hs-get-near-block (&optional include-comment) - "Reposition point to a near block around point. -It search for a valid block before and after point and return t if one -is found. - -If INCLUDE-COMMENT is non-nil, it also searches for a comment block, -returning `comment' if one is found." - (let ((c-reg (when include-comment (funcall hs-inside-comment-predicate))) - pos) - (cond - ((and c-reg (car c-reg) (hs-hideable-region-p - (car c-reg) (cadr c-reg))) - (goto-char (car c-reg)) - 'comment) - - ((and (eq hs-hide-block-behavior 'after-bol) - (save-excursion - (goto-char (line-beginning-position)) - (setq pos (hs-get-first-block)))) - (goto-char pos) - t) - - ((and (or (funcall hs-looking-at-block-start-predicate) - (and (goto-char (line-beginning-position)) - (funcall hs-find-block-beginning-function))) - (hs-hideable-region-p)) - t)))) - (defun hs-inside-comment-p () (declare (obsolete "Call `hs-inside-comment-predicate' instead." "31.1")) (funcall hs-inside-comment-predicate)) @@ -1100,51 +1154,32 @@ returning `comment' if one is found." ;; the idea is to look backwards for a comment start regexp, do a ;; forward comment, and see if we are inside, then extend ;; forward and backward as long as we have comments - (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)) - ;; first get to the beginning of this comment... - (while (and (not (bobp)) - (= (point) (progn (forward-comment -1) (point)))) - (forward-char -1)) - ;; ...then extend backwards - (forward-comment (- (buffer-size))) - (skip-chars-forward " \t\n\f") - (let ((p (point)) - (hideable t)) - (beginning-of-line) - (unless (looking-at (concat "[ \t]*" hs-c-start-regexp)) - ;; we are in this situation: (example) - ;; (defun bar () - ;; (foo) - ;; ) ; comment - ;; ^ - ;; the point was here before doing (beginning-of-line) - ;; here we should advance till the next comment which - ;; eventually has only white spaces preceding it on the same - ;; line - (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))) - ;; avoid an infinite cycle - (setq p (point)) - (forward-comment 1) - (skip-chars-forward " \t\n\f")) - (when (or (not (looking-at hs-c-start-regexp)) - (> (point) q)) - ;; we cannot hide this comment block - (setq hideable nil))) - ;; goto the end of the comment - (forward-comment (buffer-size)) - (skip-chars-backward " \t\n\f") - (end-of-line) - (when (>= (point) q) - (list (and hideable p) (point)))))))) + (let ((amount (buffer-size)) + (rx (concat "^[[:blank:]]*\\(" hs-c-start-regexp "\\)")) + beg end) + (when (or (and (skip-chars-forward "[:blank:]") + (looking-at-p hs-c-start-regexp) + ;; Check if there are not whitespaces before the comment + (if (save-excursion + (forward-line 0) (not (looking-at-p rx))) + (setq amount 1) + t)) + (and (re-search-backward rx (pos-bol) t) + (goto-char (match-beginning 1)))) + + (setq beg (if (= amount 1) + (pos-eol) + (forward-comment (- amount)) + (skip-chars-forward " \t\n\f") + (unless (save-excursion + (forward-line 0) (looking-at-p rx)) + (forward-comment 1) + (skip-chars-forward " \t\n\f")) + (pos-eol)) + end (progn (forward-comment amount) + (skip-chars-backward " \t\n\f") + (point))) + (list beg end))))) (defun hs--set-variable (var nth &optional default) "Set Hideshow VAR if already not set. @@ -1188,103 +1223,46 @@ adjust-block-beginning function." (hs--set-variable 'hs-find-next-block-function 7) (hs--set-variable 'hs-looking-at-block-start-predicate 8)) -(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))) - ;; look if current line is block start - (if (funcall hs-looking-at-block-start-predicate) - (point) - ;; look backward for the start of a block that contains the cursor - (while (and (re-search-backward hs-block-start-regexp nil t) - ;; 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) - nil)))) +(defun hs-forward-sexp (match-data _arg) + "Adjust point based on MATCH-DATA and call `hs-forward-sexp-function' with ARG. +Original match data is restored upon return." + (declare (obsolete "Use `hs-block-positions' instead." "31.1")) + (save-match-data + (set-match-data match-data) + (goto-char (match-beginning hs-block-start-mdata-select)) + (funcall hs-forward-sexp-function 1))) -(defun hs-find-next-block (regexp maxp comments) +(define-obsolete-function-alias + 'hs-find-next-block 'hs-find-next-block-fn--default "31.1") + +(defun hs-find-next-block-fn--default (regexp bound comments) "Reposition point at next block-start. Skip comments if COMMENTS is nil, and search for REGEXP in -region (point MAXP)." +region (point BOUND)." (when (not comments) (forward-comment (point-max))) - (and (< (point) maxp) - (re-search-forward regexp maxp t))) + (and (< (point) bound) + (re-search-forward regexp bound t))) -(defun hs-hide-level-recursive (arg &optional beg end) - "Recursively hide blocks between BEG and END that are ARG levels below point. -If BEG and END are not specified, it will search for a near block and -use its position instead. +(define-obsolete-function-alias + 'hs-find-block-beginning 'hs-find-block-beg-fn--default "31.1") -If point is inside a block, it will use the current block positions -instead of BEG and END." - ;; If we are near of a block, set BEG and END according to that - ;; block positions. - (when (funcall hs-find-block-beginning-function) - (let ((block (hs-block-positions))) - (setq beg (point) end (cadr block)))) - - ;; Show all blocks in that region - (unless hs-allow-nesting (hs-discard-overlays beg end)) - - ;; Skip initial block - (goto-char (1+ beg)) - - (while (funcall hs-find-next-block-function hs-block-start-regexp end nil) - (if (> arg 1) - (hs-hide-level-recursive (1- arg)) - ;; `hs-hide-block-at-point' already moves the cursor, but if it - ;; fails, return to the previous position where we were. - (unless (and (goto-char (match-beginning hs-block-start-mdata-select)) - (hs-hide-block-at-point t)) - (goto-char (match-end hs-block-start-mdata-select))))) - - (goto-char end)) - -(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, `case-fold-search' is t." - (declare (debug t)) - `(when hs-minor-mode - (let ((case-fold-search t)) - (save-match-data - (save-excursion ,@body))))) - -(defun hs-find-block-beginning-match () - "Reposition point at the end of match of the block-start regexp. +(defun hs-find-block-beg-fn--default () + "Reposition point at block-start. Return point, or nil if original point was not in a block." - (when (and (funcall hs-find-block-beginning-function) - (funcall hs-looking-at-block-start-predicate)) - ;; point is inside a block - (goto-char (match-end 0)))) - -(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 (funcall hs-inside-comment-predicate))) - (when (and c-reg (nth 0 c-reg)) - ;; point is inside a comment, and that comment is hideable - (goto-char (nth 0 c-reg)))) - ;; Search for a hidden block at EOL ... - (or (eq 'hs (get-char-property (line-end-position) 'invisible)) - ;; ... or behind the current cursor position - (eq 'hs (get-char-property (if (bobp) (point) (1- (point))) 'invisible))))) + (let ((here (point)) done) + ;; look if current line is block start + (if (funcall hs-looking-at-block-start-predicate) + here + ;; look backward for the start of a block that contains the cursor + (save-excursion + (while (and (re-search-backward hs-block-start-regexp nil t) + (goto-char (match-beginning hs-block-start-mdata-select)) + ;; go again if in a comment or a string + (or (save-match-data (nth 8 (syntax-ppss))) + (not (setq done (and (<= here (cadr (hs-block-positions))) + (point)))))))) + (when done (goto-char done))))) ;; This function is not used anymore (Bug#700). (defun hs-c-like-adjust-block-beginning (initial) @@ -1292,62 +1270,35 @@ Return point, or nil if original point was not in a block." 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-function' for C-like modes." + (declare (obsolete "Use `hs-adjust-block-beginning-function' instead." "31.1")) (save-excursion (goto-char (1- initial)) (forward-comment (- (buffer-size))) (point))) -;;--------------------------------------------------------------------------- -;; commands +;;;###autoload +(defun turn-off-hideshow () + "Unconditionally turn off `hs-minor-mode'." + (hs-minor-mode -1)) + + +;;;; Commands (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." + "Hide all top level blocks. +This command runs `hs-hide-hook'. +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)) - (syntax-propertize (point-max)) - (let ((spew (make-progress-reporter "Hiding all blocks..." - (point-min) (point-max))) - (re (when (stringp hs-block-start-regexp) - (concat "\\(" - hs-block-start-regexp - "\\)" - (if (and hs-hide-comments-when-hiding-all - (stringp hs-c-start-regexp)) - (concat "\\|\\(" - hs-c-start-regexp - "\\)") - ""))))) - (while (funcall hs-find-next-block-function re (point-max) - hs-hide-comments-when-hiding-all) - (if (match-beginning 1) - ;; We have found a block beginning. - (progn - (goto-char (match-beginning 1)) - (unless (if hs-hide-all-non-comment-function - (funcall hs-hide-all-non-comment-function) - (hs-hide-block-at-point t)) - ;; Go to end of matched data to prevent from getting stuck - ;; with an endless loop. - (when (if (stringp hs-block-start-regexp) - (looking-at hs-block-start-regexp) - (eq (point) (match-beginning 0))) - (goto-char (match-end 0))))) - ;; found a comment, probably - (let ((c-reg (funcall hs-inside-comment-predicate))) - (when (and c-reg (car c-reg)) - (if (hs-hideable-region-p (car c-reg) (nth 1 c-reg)) - (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) + (let ((spew (make-progress-reporter + "Hiding all blocks..." (point-min) (point-max)))) + (hs-hide-level-recursive + 1 (point-min) (point-max) + hs-hide-comments-when-hiding-all + hs-hide-all-non-comment-function + spew) + (progress-reporter-done spew)) (run-hooks 'hs-hide-hook))) (defun hs-show-all () @@ -1355,76 +1306,63 @@ If `hs-hide-comments-when-hiding-all' is non-nil, also hide the comments." (interactive) (hs-life-goes-on (message "Showing all blocks ...") - (let ((hs-allow-nesting nil)) + (let (hs-allow-nesting) (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") +(defun hs-hide-block () + "Select a block and hide it. +This command runs `hs-hide-hook'." + (interactive) (hs-life-goes-on (let ((c-reg (funcall hs-inside-comment-predicate))) (cond - ((and c-reg (or (null (nth 0 c-reg)) - (not (hs-hideable-region-p (car c-reg) (nth 1 c-reg))))) + ((and c-reg (not (apply #'hs-hideable-region-p c-reg))) (user-error "(not enough comment lines to hide)")) - - (c-reg (hs-hide-block-at-point end c-reg)) - - ((hs-get-near-block) (hs-hide-block-at-point))) - + ((or c-reg (hs-get-near-block)) + (hs-hide-block-at-point c-reg))) (run-hooks 'hs-hide-hook)))) -(defun hs-show-block (&optional end) +(defun hs-show-block () "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") +This command runs `hs-show-hook'. See documentation for functions +`hs-hide-block' and `run-hooks'." + (interactive) (hs-life-goes-on - (or - ;; first see if we have something at the end of the line - (let ((ov (hs-overlay-at (line-end-position))) - (here (point)) - ov-start ov-end) - (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))))) - (setq ov-start (overlay-start ov)) - (setq ov-end (overlay-end ov)) - (delete-overlay ov) - (hs--refresh-indicators ov-start ov-end) - t)) - ;; not immediately obvious, look for a suitable block - (let ((c-reg (funcall hs-inside-comment-predicate)) - p q) - (cond (c-reg - (when (car c-reg) - (setq p (car c-reg) - q (cadr c-reg)))) - ((and (funcall hs-find-block-beginning-function) - ;; ugh, fresh match-data - (funcall hs-looking-at-block-start-predicate)) - (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)))))) + (if-let* ((ov (hs-overlay-at (pos-eol))) + (ov-start (overlay-start ov)) + (ov-end (overlay-end ov))) + (progn + (hs-discard-overlays (1- ov-start) ov-end) + (hs--refresh-indicators ov-start ov-end)) + (when-let* ((block + (or (funcall hs-inside-comment-predicate) + (and (funcall hs-find-block-beginning-function) + (hs-block-positions))))) + (hs-discard-overlays (car block) (cadr block)))) (run-hooks 'hs-show-hook))) (defun hs-hide-level (arg) "Hide all blocks ARG levels below this block. +If point is not in a block, hide all the ARG levels blocks in the whole +buffer. + 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)) + (if (hs-get-near-block) + ;; Hide block if we are looking at one. + (apply #'hs-hide-level-recursive arg + (hs-block-positions)) + ;; Otherwise hide all the blocks in the current buffer + (hs-hide-level-recursive + ;; Increment ARG by 1, avoiding it acts like + ;; `hs-hide-all' + (1+ arg) + (point-min) (point-max))) (message "Hiding blocks ... done")) (run-hooks 'hs-hide-hook))) @@ -1465,15 +1403,10 @@ Argument E should be the event that triggered this action." 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") - (funcall hs-inside-comment-predicate)))) - (when c-reg - (let ((beg (car c-reg)) (end (cadr c-reg))) - ;; see if we have enough comment lines to hide - (when (hs-hideable-region-p beg end) - (hs-hide-comment-region beg end))))))) + (goto-char (point-min)) + (skip-chars-forward " \t\n\f") + (when-let* ((c-reg (funcall hs-inside-comment-predicate))) + (hs-hide-block-at-point c-reg)))) (defun hs-cycle (&optional level) "Cycle the visibility state of the current block. @@ -1490,11 +1423,12 @@ only blocks which are that many levels below the level of point." (hs-toggle-hiding) (message "Toggle visibility")) ((> level 1) - (hs-hide-level-recursive level) + (apply #'hs-hide-level-recursive level + (hs-block-positions)) (message "Hide %d level" level)) (t (let* (hs-allow-nesting - (block (hs-block-positions)) + (block (hs-block-positions nil :ad-end)) (ov (seq-find (lambda (o) (and (eq (overlay-get o 'invisible) 'hs))) @@ -1505,9 +1439,8 @@ only blocks which are that many levels below the level of point." (hs-hide-block) (message "Hide block and nested blocks")) ;; Hide the children blocks if the parent block is hidden - ((and (= (overlay-start ov) (car block)) - (= (overlay-end ov) (cadr block))) - (hs-hide-level-recursive 1) + ((= (overlay-end ov) (cadr block)) + (apply #'hs-hide-level-recursive 1 block) (message "Hide first nested blocks")) ;; Otherwise show all in the parent block, we cannot use ;; `hs-show-block' here because we already know the @@ -1533,10 +1466,6 @@ 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'. - Turning hideshow minor mode off reverts the menu bar and the variables to default values and disables the hideshow commands. @@ -1556,12 +1485,11 @@ Key bindings: (user-error "%S doesn't support the Hideshow minor mode" major-mode)) - ;; Set the variables + ;; Set the old variables (hs-grok-mode-type) ;; Turn off this mode if we change major modes. (add-hook 'change-major-mode-hook - #'turn-off-hideshow - nil t) + #'turn-off-hideshow nil t) (setq-local line-move-ignore-invisible t) (add-to-invisibility-spec '(hs . t)) ;; Add block indicators @@ -1575,21 +1503,12 @@ Key bindings: (jit-lock-register #'hs--add-indicators))) (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)) + (remove-overlays nil nil 'hs-indicator t) + (remove-overlays nil nil 'invisible 'hs) (when hs-show-indicators - (jit-lock-unregister #'hs--add-indicators) - (remove-overlays nil nil 'hs-indicator t)))) - -;;;###autoload -(defun turn-off-hideshow () - "Unconditionally turn off `hs-minor-mode'." - (hs-minor-mode -1)) - -;;--------------------------------------------------------------------------- -;; that's it + (jit-lock-unregister #'hs--add-indicators)))) + +;;;; that's it (provide 'hideshow) - ;;; hideshow.el ends here diff --git a/test/lisp/progmodes/hideshow-tests.el b/test/lisp/progmodes/hideshow-tests.el index 9cf60c1ec84..39161f2455c 100644 --- a/test/lisp/progmodes/hideshow-tests.el +++ b/test/lisp/progmodes/hideshow-tests.el @@ -246,7 +246,7 @@ sub() (should (string= (hideshow-tests-visible-string) contents))))) (ert-deftest hideshow-hide-level-1 () - "Should hide 1st level blocks." + "Should hide 2st level blocks." (hideshow-tests-with-temp-buffer c-mode " @@ -274,40 +274,6 @@ main(int argc, char **argv) \"String\" -int -main(int argc, char **argv) -{} -")))) - -(ert-deftest hideshow-hide-level-2 () - "Should hide 2nd level blocks." - (hideshow-tests-with-temp-buffer - c-mode - " -/* - Comments -*/ - -\"String\" - -int -main(int argc, char **argv) -{ - if (argc > 1) { - printf(\"Hello\\n\"); - } -} -" - (hs-hide-level 2) - (should (string= - (hideshow-tests-visible-string) - " -/* - Comments -*/ - -\"String\" - int main(int argc, char **argv) { diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index b9130da495d..6ddd57c9db2 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -7428,7 +7428,7 @@ class SomeClass: (or enabled (hs-minor-mode -1))))) (ert-deftest python-hideshow-hide-levels-3 () - "Should hide all blocks." + "Should hide 2nd level blocks." (python-tests-with-temp-buffer " def f(): @@ -7447,19 +7447,22 @@ def g(): (python-tests-visible-string) " def f(): + if 0: def g(): + pass ")))) (ert-deftest python-hideshow-hide-levels-4 () - "Should hide 2nd level block." + "Should hide 3nd level block." (python-tests-with-temp-buffer " def f(): if 0: l = [i for i in range(5) if i < 3] - abc = o.match(1, 2, 3) + if 1: + abc = o.match(1, 2, 3) def g(): pass @@ -7472,6 +7475,9 @@ def g(): " def f(): if 0: + l = [i for i in range(5) + if i < 3] + if 1: def g(): pass