procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

hideshow.el: Improve hs-toggle-hiding behavior

Browse source 
* lisp/progmodes/hideshow.el
(hs-find-block-beginning-match): New function to be used in
`hs-already-hidden-p'.
(hs-already-hidden-p): Add check if beginning of line is inside a
block.
(hs-toggle-hiding): Don't change to selected-window's buffer when
event arg is absent.

* test/lisp/progmodes/hideshow-tests.el
(hideshow-tests-with-temp-buffer-selected): New helper macro.
(hideshow-tests-make-event-at): New helper function.
(hideshow-already-hidden-p-1): New test.
(hideshow-toggle-hiding-1): New test.
(hideshow-mouse-toggle-hiding-1): New test (bug#52092).
This commit is contained in:
kobarity 2022-09-19 13:43:33 +09:00 • committed by Stefan Monnier
parent c1cead89f5
commit 2084f4ada3
2 changed files with 122 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
lisp/progmodes/hideshow.el
View file

@ -786,6 +786,14 @@ and `case-fold-search' are both t."
(case-fold-search t))
,@body)))
(defun hs-find-block-beginning-match ()
"Reposition point at the end of match of the block-start regexp.
Return point, or nil if original point was not in a block."
(when (and (funcall hs-find-block-beginning-func)
(funcall hs-looking-at-block-start-p-func))
;; 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))
@ -797,19 +805,18 @@ and `case-fold-search' are both t."
(defun hs-already-hidden-p ()
"Return non-nil if point is in an already-hidden block, otherwise nil."
;; FIXME: We should probably also consider ourselves "in" a hidden block
;; when point is right at the edge after a hidden block (bug#52092).
(save-excursion
(let ((c-reg (hs-inside-comment-p)))
(if (and c-reg (nth 0 c-reg))
;; point is inside a comment, and that comment is hideable
(goto-char (nth 0 c-reg))
(end-of-line)
(when (and (not c-reg)
(funcall hs-find-block-beginning-func)
(funcall hs-looking-at-block-start-p-func))
;; point is inside a block
(goto-char (match-end 0)))))
(when (not c-reg)
(end-of-line)
(when (not (hs-find-block-beginning-match))
;; We should also consider ourselves "in" a hidden block when
;; point is right at the edge after a hidden block (bug#52092).
(beginning-of-line)
(hs-find-block-beginning-match)))))
(end-of-line)
(hs-overlay-at (point))))
@ -952,7 +959,7 @@ See `hs-hide-block' and `hs-show-block'.
Argument E should be the event that triggered this action."
(interactive (list last-nonmenu-event))
(hs-life-goes-on
(posn-set-point (event-end e))
(when e (posn-set-point (event-end e)))
(if (hs-already-hidden-p)
(hs-show-block)
(hs-hide-block))))

106
test/lisp/progmodes/hideshow-tests.el
View file

@ -41,6 +41,18 @@ always located at the beginning of buffer."
(goto-char (point-min))
,@body))
(defmacro hideshow-tests-with-temp-buffer-selected (mode contents &rest body)
"Create and switch to a `hs-minor-mode' enabled MODE temp buffer with CONTENTS.
BODY is code to be executed within the temp buffer. Point is
always located at the beginning of buffer."
(declare (indent 1) (debug t))
`(ert-with-test-buffer-selected ()
(,mode)
(hs-minor-mode 1)
(insert ,contents)
(goto-char (point-min))
,@body))
(defun hideshow-tests-look-at (string &optional num restore-point)
"Move point at beginning of STRING in the current buffer.
Optional argument NUM defaults to 1 and is an integer indicating
@ -96,6 +108,39 @@ default to `point-min' and `point-max' respectively."
(overlay-end overlay))))
(buffer-substring-no-properties (point-min) (point-max)))))
(defun hideshow-tests-make-event-at (string)
"Make dummy mouse event at beginning of STRING."
(save-excursion
(let ((pos (hideshow-tests-look-at string)))
(vector
`(S-mouse-2
(,(get-buffer-window) ,pos (1 . 1) 0 nil ,pos (1 . 1)
nil (1 . 1) (1 . 1)))))))
(ert-deftest hideshow-already-hidden-p-1 ()
(let ((contents "
int
main()
{
printf(\"Hello\\n\");
}
"))
(hideshow-tests-with-temp-buffer
c-mode
contents
(hideshow-tests-look-at "printf")
(should (not (hs-already-hidden-p)))
(hs-hide-block)
(goto-char (point-min))
(hideshow-tests-look-at "{")
(should (hs-already-hidden-p))
(forward-line -1)
(should (not (hs-already-hidden-p)))
(hideshow-tests-look-at "}")
(should (hs-already-hidden-p))
(forward-line)
(should (not (hs-already-hidden-p))))))
(ert-deftest hideshow-hide-block-1 ()
"Should hide current block."
(let ((contents "
@ -263,6 +308,67 @@ main(int argc, char **argv)
}
"))))
(ert-deftest hideshow-toggle-hiding-1 ()
"Should toggle hiding/showing of a block."
(let ((contents "
int
main()
{
printf(\"Hello\\n\");
}
"))
(hideshow-tests-with-temp-buffer
c-mode
contents
(hideshow-tests-look-at "printf")
(hs-toggle-hiding)
(should (string=
(hideshow-tests-visible-string)
"
int
main()
{}
"))
(hs-toggle-hiding)
(should (string= (hideshow-tests-visible-string) contents)))))
(ert-deftest hideshow-mouse-toggle-hiding-1 ()
"Should toggle hiding/showing of a block by mouse events."
(let ((contents "
int
main()
{
printf(\"Hello\\n\");
}
")
(hidden "
int
main()
{}
")
(call-at (lambda (str)
(let* ((events (hideshow-tests-make-event-at str))
(last-nonmenu-event (aref events 0)))
(call-interactively #'hs-toggle-hiding nil events)))))
(hideshow-tests-with-temp-buffer-selected
c-mode
contents
;; Should not hide the block when clicked outside of the block.
(funcall call-at "int")
(should (string= (hideshow-tests-visible-string) contents))
;; Should hide the block when clicked inside of the block.
(goto-char (point-min))
(funcall call-at "printf")
(should (string= (hideshow-tests-visible-string) hidden))
;; Should not show the block when clicked outside of the block.
(goto-char (point-min))
(funcall call-at "int")
(should (string= (hideshow-tests-visible-string) hidden))
;; Should show the block when clicked inside of the block.
(goto-char (point-min))
(funcall call-at "}")
(should (string= (hideshow-tests-visible-string) contents)))))
(provide 'hideshow-tests)
;;; hideshow-tests.el ends here