Fix `org-occur' when regexp matches a single char

* lisp/org.el (org-occur): Fix infloop when regexp matches a single
  char.  Improve docstring.

(org-check-before-date):
(org-check-after-date):
(org-check-dates-range): Match correct object since point may be at the
beginning of the next one.

* testing/lisp/test-org.el (test-org/occur): New test.
This commit is contained in:
Nicolas Goaziou 2016-05-05 10:18:21 +02:00
parent 1ca1d52e92
commit 83e373f109
2 changed files with 45 additions and 12 deletions

View File

@ -13930,14 +13930,18 @@ as well.")
(defun org-occur (regexp &optional keep-previous callback)
"Make a compact tree which shows all matches of REGEXP.
The tree will show the lines where the regexp matches, and all higher
headlines above the match. It will also show the heading after the match,
to make sure editing the matching entry is easy.
If KEEP-PREVIOUS is non-nil, highlighting and exposing done by a previous
call to `org-occur' will be kept, to allow stacking of calls to this
command.
If CALLBACK is non-nil, it is a function which is called to confirm
that the match should indeed be shown."
The tree will show the lines where the regexp matches, and any other context
defined in `org-show-context-detail', which see.
When optional argument KEEP-PREVIOUS is non-nil, highlighting and exposing
done by a previous call to `org-occur' will be kept, to allow stacking of
calls to this command.
Optional argument CALLBACK can be a function of no argument. In this case,
it is called with point at the end of the match, match data being set
accordingly. Current match is shown only if the return value is non-nil.
The function must neither move point nor alter narrowing."
(interactive "sRegexp: \nP")
(when (equal regexp "")
(user-error "Regexp cannot be empty"))
@ -13952,7 +13956,6 @@ that the match should indeed be shown."
;; hide everything
(org-overview))
(while (re-search-forward regexp nil t)
(backward-char) ;; FIXME: Match timestamps at the end of a headline
(when (or (not callback)
(save-match-data (funcall callback)))
(setq cnt (1+ cnt))
@ -17549,7 +17552,10 @@ both scheduled and deadline timestamps."
`(lambda ()
(let ((match (match-string 1)))
(and ,(if (memq org-ts-type '(active inactive all))
'(eq (org-element-type (org-element-context)) 'timestamp)
'(eq (org-element-type (save-excursion
(backward-char)
(org-element-context)))
'timestamp)
'(org-at-planning-p))
(time-less-p
(org-time-string-to-time match)
@ -17566,7 +17572,10 @@ both scheduled and deadline timestamps."
`(lambda ()
(let ((match (match-string 1)))
(and ,(if (memq org-ts-type '(active inactive all))
'(eq (org-element-type (org-element-context)) 'timestamp)
'(eq (org-element-type (save-excursion
(backward-char)
(org-element-context)))
'timestamp)
'(org-at-planning-p))
(not (time-less-p
(org-time-string-to-time match)
@ -17585,7 +17594,10 @@ both scheduled and deadline timestamps."
(let ((match (match-string 1)))
(and
,(if (memq org-ts-type '(active inactive all))
'(eq (org-element-type (org-element-context)) 'timestamp)
'(eq (org-element-type (save-excursion
(backward-char)
(org-element-context)))
'timestamp)
'(org-at-planning-p))
(not (time-less-p
(org-time-string-to-time match)

View File

@ -4015,6 +4015,27 @@ Paragraph<point>"
(search-forward "H2")
(org-invisible-p2))))
(ert-deftest test-org/occur ()
"Test `org-occur' specifications."
;; Count number of matches.
(should
(= 1
(org-test-with-temp-text "* H\nA\n* H2"
(org-occur "A"))))
(should
(= 2
(org-test-with-temp-text "* H\nA\n* H2\nA"
(org-occur "A"))))
;; Test CALLBACK optional argument.
(should
(= 0
(org-test-with-temp-text "* H\nA\n* H2"
(org-occur "A" nil (lambda () (equal (org-get-heading) "H2"))))))
(should
(= 1
(org-test-with-temp-text "* H\nA\n* H2\nA"
(org-occur "A" nil (lambda () (equal (org-get-heading) "H2")))))))
;;; Timestamps API