Adjust `org-at-timestamp-p' behavior

* lisp/org.el (org-at-timestamp-p): Change optional argument
  behaviour.  Remove interactive call.
(org-follow-timestamp-link):
(org-get-repeat):
(org-auto-repeat-maybe):
(org-time-stamp):
(org-timestamp-up-day):
(org-timestamp-down-day):
(org-toggle-timestamp-type):
(org-timestamp-change):
(org-goto-calendar):
(org-date-from-calendar):
(org-shiftup):
(org-shiftdown):
(org-shiftright):
(org-shiftleft):
(org-org-menu):
(org-fill-paragraph-with-timestamp-nobreak-p):
(org-shiftcontrolup):
(org-shiftcontroldown):
* lisp/org-agenda.el (org-agenda-date-later):
(org-agenda-date-prompt):
* lisp/org-clock.el (org-clock-timestamps-change):
* lisp/org-mouse.el (org-mouse-delete-timestamp):
(org-mouse-context-menu):
* lisp/org-table.el (org-table-copy-down): Update callers.

* testing/lisp/test-org.el (test-org/at-timestamp-p): Add tests.
This commit is contained in:
Nicolas Goaziou 2017-05-14 10:38:26 +02:00
parent cbbe00e30e
commit dbe2424b07
7 changed files with 155 additions and 95 deletions

View File

@ -21,6 +21,12 @@ them, consider modifying ~org-duration-format~ instead.
Variable ~org-time-clocksum-use-effort-durations~ is also obsolete.
Consider setting ~org-duration-units~ instead.
*** ~org-at-timestamp-p~ optional argument accepts different values
See docustrings for the allowed values. For backward compatibility,
~(org-at-timestamp-p t)~ is still supported, but should be updated
accordingly.
*** ~org-capture-templates~ no longer accepts S-expressions as file names
Since functions are allowed there, a straightforward way to migrate

View File

@ -9097,8 +9097,7 @@ Called with a universal prefix arg, show the priority instead of setting it."
(with-current-buffer buffer
(widen)
(goto-char pos)
(if (not (org-at-timestamp-p))
(error "Cannot find time stamp"))
(unless (org-at-timestamp-p 'lax) (error "Cannot find time stamp"))
(when (and org-agenda-move-date-from-past-immediately-to-today
(equal arg 1)
(or (not what) (eq what 'day))
@ -9180,8 +9179,7 @@ be used to request time specification in the time stamp."
(with-current-buffer buffer
(widen)
(goto-char pos)
(if (not (org-at-timestamp-p t))
(error "Cannot find time stamp"))
(unless (org-at-timestamp-p 'lax) (error "Cannot find time stamp"))
(org-time-stamp arg (equal (char-after (match-beginning 0)) ?\[)))
(org-agenda-show-new-time marker org-last-changed-timestamp))
(message "Time stamp changed to %s" org-last-changed-timestamp)))

View File

@ -1681,7 +1681,7 @@ UPDOWN tells whether to change `up' or `down'.
Optional argument N tells to change by that many units."
(let ((tschange (if (eq updown 'up) 'org-timestamp-up
'org-timestamp-down))
(timestamp? (org-at-timestamp-p t))
(timestamp? (org-at-timestamp-p 'lax))
ts1 begts1 ts2 begts2 updatets1 tdiff)
(when timestamp?
(save-excursion

View File

@ -391,8 +391,8 @@ DEFAULT is returned if no priority is given in the headline."
(defun org-mouse-delete-timestamp ()
"Deletes the current timestamp as well as the preceding keyword.
SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
(when (or (org-at-date-range-p) (org-at-timestamp-p))
(replace-match "") ; delete the timestamp
(when (or (org-at-date-range-p) (org-at-timestamp-p 'lax))
(replace-match "") ;delete the timestamp
(skip-chars-backward " :A-Z")
(when (looking-at " *[A-Z][A-Z]+:")
(replace-match ""))))
@ -714,7 +714,7 @@ This means, between the beginning of line and the point."
(org-tags-sparse-tree nil ,(match-string 1))]
"--"
,@(org-mouse-tag-menu))))
((org-at-timestamp-p)
((org-at-timestamp-p 'lax)
(popup-menu
'(nil
["Show Day" org-open-at-point t]

View File

@ -1122,28 +1122,28 @@ to a number. In the case of a timestamp, increment by days."
txt txt-up inc)
(org-table-check-inside-data-field)
(if (not non-empty)
(save-excursion
(setq txt
(catch 'exit
(while (progn (beginning-of-line 1)
(re-search-backward org-table-dataline-regexp
beg t))
(org-table-goto-column colpos t)
(if (and (looking-at
"|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|")
(<= (setq n (1- n)) 0))
(throw 'exit (match-string 1))))))
(setq field-up
(catch 'exit
(while (progn (beginning-of-line 1)
(re-search-backward org-table-dataline-regexp
beg t))
(org-table-goto-column colpos t)
(if (and (looking-at
"|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|")
(<= (setq n (1- n)) 0))
(throw 'exit (match-string 1))))))
(setq non-empty-up (and field-up (string-match "[^ \t]" field-up))))
(save-excursion
(setq txt
(catch 'exit
(while (progn (beginning-of-line 1)
(re-search-backward org-table-dataline-regexp
beg t))
(org-table-goto-column colpos t)
(if (and (looking-at
"|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|")
(<= (setq n (1- n)) 0))
(throw 'exit (match-string 1))))))
(setq field-up
(catch 'exit
(while (progn (beginning-of-line 1)
(re-search-backward org-table-dataline-regexp
beg t))
(org-table-goto-column colpos t)
(if (and (looking-at
"|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|")
(<= (setq n (1- n)) 0))
(throw 'exit (match-string 1))))))
(setq non-empty-up (and field-up (string-match "[^ \t]" field-up))))
;; Above field was not empty, go down to the next row
(setq txt (org-trim field))
(org-table-next-row)
@ -1170,7 +1170,7 @@ to a number. In the case of a timestamp, increment by days."
(setq txt (calc-eval (concat txt "+" (number-to-string inc)))))
(insert txt)
(org-move-to-column col)
(if (and org-table-copy-increment (org-at-timestamp-p t))
(if (and org-table-copy-increment (org-at-timestamp-p))
(org-timestamp-up-day inc)
(org-table-maybe-recalculate-line))
(org-table-align)

View File

@ -11194,7 +11194,7 @@ or to another Org file, automatically push the old position onto the ring."
(format "*Org Agenda(a:%s)"
(concat (substring t1 0 10) "--" (substring t2 0 10)))))
(org-agenda-list nil tt1 (1+ (- tt2 tt1))))))
((org-at-timestamp-p t)
((org-at-timestamp-p 'lax)
(let ((org-agenda-buffer-tmp-name
(format "*Org Agenda(a:%s)" (substring (match-string 1) 0 10))))
(org-agenda-list nil (time-to-days (org-time-string-to-time
@ -13099,7 +13099,7 @@ repeater from there instead."
(let ((end (org-entry-end-position)))
(catch :repeat
(while (re-search-forward org-repeat-re end t)
(when (save-match-data (org-at-timestamp-p))
(when (save-match-data (org-at-timestamp-p 'agenda))
(throw :repeat (match-string-no-properties 1)))))))))))
(defvar org-last-changed-timestamp)
@ -13170,7 +13170,7 @@ This function is run automatically after each state change to a DONE state."
(match-string 0)))))
(cond
;; Ignore fake time-stamps (e.g., within comments).
((not (org-at-timestamp-p t)))
((not (org-at-timestamp-p 'agenda)))
;; Time-stamps without a repeater are usually
;; skipped. However, a SCHEDULED time-stamp without
;; one is removed, as they are no longer relevant.
@ -16620,7 +16620,7 @@ non-nil."
(let* ((ts (cond
((org-at-date-range-p t)
(match-string (if (< (point) (- (match-beginning 2) 2)) 1 2)))
((org-at-timestamp-p t) (match-string 0))))
((org-at-timestamp-p 'lax) (match-string 0))))
;; Default time is either the timestamp at point or today.
;; When entering a range, only the range start is considered.
(default-time (if (not ts) (current-time)
@ -16648,9 +16648,9 @@ non-nil."
(ts
;; Make sure we're on a timestamp. When in the middle of a date
;; range, move arbitrarily to range end.
(unless (org-at-timestamp-p t)
(unless (org-at-timestamp-p 'lax)
(skip-chars-forward "-")
(org-at-timestamp-p t))
(org-at-timestamp-p 'lax))
(replace-match "")
(setq org-last-changed-timestamp
(org-insert-time-stamp
@ -17867,7 +17867,7 @@ With prefix ARG, change by that many units."
"Increase the date in the time stamp by one day.
With prefix ARG, change that many days."
(interactive "p")
(if (and (not (org-at-timestamp-p t))
(if (and (not (org-at-timestamp-p 'lax))
(org-at-heading-p))
(org-todo 'up)
(org-timestamp-change (prefix-numeric-value arg) 'day 'updown)))
@ -17876,52 +17876,68 @@ With prefix ARG, change that many days."
"Decrease the date in the time stamp by one day.
With prefix ARG, change that many days."
(interactive "p")
(if (and (not (org-at-timestamp-p t))
(if (and (not (org-at-timestamp-p 'lax))
(org-at-heading-p))
(org-todo 'down)
(org-timestamp-change (- (prefix-numeric-value arg)) 'day) 'updown))
(defun org-at-timestamp-p (&optional inactive-ok)
(defun org-at-timestamp-p (&optional extended)
"Non-nil if point is inside a timestamp.
When optional argument INACTIVE-OK is non-nil, also consider
inactive timestamps.
By default, the function only consider syntactically valid active
timestamps. However, the caller may have a broader definition
for timestamps. As a consequence, optional argument EXTENDED can
be set to the following values
When this function returns a non-nil value, match data is set
according to `org-ts-regexp3' or `org-ts-regexp2', depending on
INACTIVE-OK.
`inactive'
Return the position of the point as a symbol among `bracket',
`after', `year', `month', `hour', `minute', `day' or a number of
character from the last know part of the time stamp.
Include also syntactically valid inactive timestamps.
This function checks context and only return non-nil for valid
time stamps. If you need to match anything looking like a time
stamp, or if you are sure about the context, consider using
`org-in-regexp', e.g.,
`agenda'
(org-in-regexp org-ts-regexp)
Include timestamps allowed in Agenda, i.e., those in
properties drawers, planning lines and clock lines.
Unlike to `org-element-context', the function recognizes time
stamps in properties drawers, planning lines and clocks."
(interactive)
(let* ((tsr (if inactive-ok org-ts-regexp3 org-ts-regexp2))
`lax'
Ignore context. The function matches any part of the
document looking like a timestamp. This includes comments,
example blocks...
For backward-compatibility with Org 9.0, every other non-nil
value is equivalent to `inactive'.
When at a timestamp, return the position of the point as a symbol
among `bracket', `after', `year', `month', `hour', `minute',
`day' or a number of character from the last know part of the
time stamp.
When matching, the match groups are the following:
group 1: year
group 2: month
group 3: day number
group 4: day name
group 5: hours, if any
group 6: minutes, if any"
(let* ((regexp (if extended org-ts-regexp3 org-ts-regexp2))
(pos (point))
(match
(let ((boundaries (org-in-regexp tsr)))
(match?
(let ((boundaries (org-in-regexp regexp)))
(save-match-data
(cond ((null boundaries) nil)
((org-at-planning-p))
((org-at-property-p))
;; CLOCK lines only contain inactive time-stamps.
((and inactive-ok (org-at-clock-log-p)))
((eq extended 'lax) t)
(t
(eq 'timestamp
(save-excursion
(when (= pos (cdr boundaries)) (forward-char -1))
(org-element-type (org-element-context))))))))))
(or (and (eq extended 'agenda)
(or (org-at-planning-p)
(org-at-property-p)
(and org-agenda-include-inactive-timestamps
(org-at-clock-log-p))))
(eq 'timestamp
(save-excursion
(when (= pos (cdr boundaries)) (forward-char -1))
(org-element-type (org-element-context)))))))))))
(cond
((not match) nil)
((not match?) nil)
((= pos (match-beginning 0)) 'bracket)
;; Distinguish location right before the closing bracket from
;; right after it.
@ -17936,12 +17952,12 @@ stamps in properties drawers, planning lines and clocks."
((and (> pos (or (match-end 8) (match-end 5)))
(< pos (match-end 0)))
(- pos (or (match-end 8) (match-end 5))))
(t 'day))))
(t 'day))))
(defun org-toggle-timestamp-type ()
"Toggle the type (<active> or [inactive]) of a time stamp."
(interactive)
(when (org-at-timestamp-p t)
(when (org-at-timestamp-p 'lax)
(let ((beg (match-beginning 0)) (end (match-end 0))
(map '((?\[ . "<") (?\] . ">") (?< . "[") (?> . "]"))))
(save-excursion
@ -17966,7 +17982,7 @@ The date will be changed by N times WHAT. WHAT can be `day', `month',
in the timestamp determines what will be changed.
When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
(let ((origin (point))
(timestamp? (org-at-timestamp-p t))
(timestamp? (org-at-timestamp-p 'lax))
origin-cat
with-hm inactive
(dm (max (nth 1 org-time-stamp-rounding-minutes) 1))
@ -18150,14 +18166,12 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
If there is a time stamp in the current line, go to that date.
A prefix ARG can be used to force the current date."
(interactive "P")
(let ((tsr org-ts-regexp) diff
(calendar-move-hook nil)
(let ((calendar-move-hook nil)
(calendar-view-holidays-initially-flag nil)
(calendar-view-diary-initially-flag nil))
(when (or (org-at-timestamp-p)
(save-excursion
(beginning-of-line 1)
(looking-at (concat ".*" tsr))))
(calendar-view-diary-initially-flag nil)
diff)
(when (or (org-at-timestamp-p 'lax)
(org-match-line (concat ".*" org-ts-regexp)))
(let ((d1 (time-to-days (current-time)))
(d2 (time-to-days
(org-time-string-to-time (match-string 1)))))
@ -18176,7 +18190,7 @@ A prefix ARG can be used to force the current date."
"Insert time stamp corresponding to cursor date in *Calendar* buffer.
If there is already a time stamp at the cursor position, update it."
(interactive)
(if (org-at-timestamp-p t)
(if (org-at-timestamp-p 'lax)
(org-timestamp-change 0 'calendar)
(let ((cal-date (org-get-date-from-calendar)))
(org-insert-time-stamp
@ -20476,7 +20490,7 @@ depending on context. See the individual commands for more information."
((run-hook-with-args-until-success 'org-shiftup-hook))
((and org-support-shift-select (org-region-active-p))
(org-call-for-shift-select 'previous-line))
((org-at-timestamp-p t)
((org-at-timestamp-p 'lax)
(call-interactively (if org-edit-timestamp-down-means-later
'org-timestamp-down 'org-timestamp-up)))
((and (not (eq org-support-shift-select 'always))
@ -20500,7 +20514,7 @@ depending on context. See the individual commands for more information."
((run-hook-with-args-until-success 'org-shiftdown-hook))
((and org-support-shift-select (org-region-active-p))
(org-call-for-shift-select 'next-line))
((org-at-timestamp-p t)
((org-at-timestamp-p 'lax)
(call-interactively (if org-edit-timestamp-down-means-later
'org-timestamp-up 'org-timestamp-down)))
((and (not (eq org-support-shift-select 'always))
@ -20529,7 +20543,7 @@ Depending on context, this does one of the following:
((run-hook-with-args-until-success 'org-shiftright-hook))
((and org-support-shift-select (org-region-active-p))
(org-call-for-shift-select 'forward-char))
((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day))
((org-at-timestamp-p 'lax) (call-interactively 'org-timestamp-up-day))
((and (not (eq org-support-shift-select 'always))
(org-at-heading-p))
(let ((org-inhibit-logging
@ -20565,7 +20579,7 @@ Depending on context, this does one of the following:
((run-hook-with-args-until-success 'org-shiftleft-hook))
((and org-support-shift-select (org-region-active-p))
(org-call-for-shift-select 'backward-char))
((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day))
((org-at-timestamp-p 'lax) (call-interactively 'org-timestamp-down-day))
((and (not (eq org-support-shift-select 'always))
(org-at-heading-p))
(let ((org-inhibit-logging
@ -20617,7 +20631,7 @@ Depending on context, this does one of the following:
"Change timestamps synchronously up in CLOCK log lines.
Optional argument N tells to change by that many units."
(interactive "P")
(if (and (org-at-clock-log-p) (org-in-regexp org-ts-regexp-inactive))
(if (and (org-at-clock-log-p) (org-at-timestamp-p 'lax))
(let (org-support-shift-select)
(org-clock-timestamps-up n))
(user-error "Not at a clock log")))
@ -20626,7 +20640,7 @@ Optional argument N tells to change by that many units."
"Change timestamps synchronously down in CLOCK log lines.
Optional argument N tells to change by that many units."
(interactive "P")
(if (and (org-at-clock-log-p) (org-in-regexp org-ts-regexp-inactive))
(if (and (org-at-clock-log-p) (org-at-timestamp-p 'lax))
(let (org-support-shift-select)
(org-clock-timestamps-down n))
(user-error "Not at a clock log")))
@ -21463,10 +21477,10 @@ an argument, unconditionally call `org-insert-heading'."
["Timestamp" org-time-stamp (not (org-before-first-heading-p))]
["Timestamp (inactive)" org-time-stamp-inactive (not (org-before-first-heading-p))]
("Change Date"
["1 Day Later" org-shiftright (org-at-timestamp-p)]
["1 Day Earlier" org-shiftleft (org-at-timestamp-p)]
["1 ... Later" org-shiftup (org-at-timestamp-p)]
["1 ... Earlier" org-shiftdown (org-at-timestamp-p)])
["1 Day Later" org-shiftright (org-at-timestamp-p 'lax)]
["1 Day Earlier" org-shiftleft (org-at-timestamp-p 'lax)]
["1 ... Later" org-shiftup (org-at-timestamp-p 'lax)]
["1 ... Earlier" org-shiftdown (org-at-timestamp-p 'lax)])
["Compute Time Range" org-evaluate-time-range t]
["Schedule Item" org-schedule (not (org-before-first-heading-p))]
["Deadline" org-deadline (not (org-before-first-heading-p))]
@ -22898,7 +22912,7 @@ assumed to be significant there."
(defun org-fill-paragraph-with-timestamp-nobreak-p ()
"Non-nil when a new line at point would split a timestamp."
(and (org-at-timestamp-p t)
(and (org-at-timestamp-p 'lax)
(not (looking-at org-ts-regexp-both))))
(declare-function message-in-body-p "message" ())

View File

@ -5781,25 +5781,67 @@ Paragraph<point>"
(eq 'after
(org-test-with-temp-text "<2012-03-29 Thu><point>»"
(org-at-timestamp-p))))
;; Test optional argument.
;; Test `inactive' optional argument.
(should
(org-test-with-temp-text "[2012-03-29 Thu]"
(org-at-timestamp-p t)))
(org-at-timestamp-p 'inactive)))
(should-not
(org-test-with-temp-text "[2012-03-29 Thu]"
(org-at-timestamp-p)))
;; Unlike `org-element-context', recognize time-stamps in planning
;; info line, property drawers and clocks.
;; When optional argument is `agenda', recognize time-stamps in
;; planning info line, property drawers and clocks.
(should
(org-test-with-temp-text "* H\nSCHEDULED: <point><2012-03-29 Thu>"
(org-at-timestamp-p 'agenda)))
(should-not
(org-test-with-temp-text "* H\nSCHEDULED: <point><2012-03-29 Thu>"
(org-at-timestamp-p)))
(should
(org-test-with-temp-text
"* H\n:PROPERTIES:\n:PROP: <point><2012-03-29 Thu>\n:END:"
(org-at-timestamp-p 'agenda)))
(should-not
(org-test-with-temp-text
"* H\n:PROPERTIES:\n:PROP: <point><2012-03-29 Thu>\n:END:"
(org-at-timestamp-p)))
(should
(org-test-with-temp-text "CLOCK: <point>[2012-03-29 Thu]"
(org-at-timestamp-p t))))
(let ((org-agenda-include-inactive-timestamps t))
(org-at-timestamp-p 'agenda))))
(should-not
(org-test-with-temp-text "CLOCK: <point>[2012-03-29 Thu]"
(let ((org-agenda-include-inactive-timestamps t))
(org-at-timestamp-p))))
(should-not
(org-test-with-temp-text "CLOCK: <point>[2012-03-29 Thu]"
(let ((org-agenda-include-inactive-timestamps t))
(org-at-timestamp-p 'inactive))))
;; When optional argument is `lax', match any part of the document
;; with Org timestamp syntax.
(should
(org-test-with-temp-text "# <2012-03-29 Thu><point>"
(org-at-timestamp-p 'lax)))
(should-not
(org-test-with-temp-text "# <2012-03-29 Thu><point>"
(org-at-timestamp-p)))
(should
(org-test-with-temp-text ": <2012-03-29 Thu><point>"
(org-at-timestamp-p 'lax)))
(should-not
(org-test-with-temp-text ": <2012-03-29 Thu><point>"
(org-at-timestamp-p)))
(should
(org-test-with-temp-text
"#+BEGIN_EXAMPLE\n<2012-03-29 Thu><point>\n#+END_EXAMPLE"
(org-at-timestamp-p 'lax)))
(should-not
(org-test-with-temp-text
"#+BEGIN_EXAMPLE\n<2012-03-29 Thu><point>\n#+END_EXAMPLE"
(org-at-timestamp-p)))
;; Optional argument `lax' also matches inactive timestamps.
(should
(org-test-with-temp-text "# [2012-03-29 Thu]<point>"
(org-at-timestamp-p 'lax))))
(ert-deftest test-org/time-stamp ()
"Test `org-time-stamp' specifications."