summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2017-02-03 00:20:12 +0100
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2017-02-03 00:20:12 +0100
commit2a59d2f76f45853c0dc649a56e14e7e9d67d2bd6 (patch)
treed4f848982e3028a9fcb626d79622f1182d08ad1b
parentadfc9fb4dd10a3503d0a27e1f19e48fd4ba5e83b (diff)
downloadorg-mode-2a59d2f76f45853c0dc649a56e14e7e9d67d2bd6.tar.gz
Harden `org-at-timestamp-p'
* lisp/org.el (org-ts-what): Remove variable. (org-at-timestamp-p): Do strict checking. Also return a value instead of setting `org-ts-what'. Improve docstring. (org-timestamp-change): Remove use of `org-ts-what'. (org-shiftcontrolup): (org-shiftcontroldown): Optimize. * lisp/org-clock.el (org-clock-timestamp-change): Remove use of `org-ts-what'.
-rw-r--r--lisp/org-clock.el25
-rw-r--r--lisp/org.el119
2 files changed, 80 insertions, 64 deletions
diff --git a/lisp/org-clock.el b/lisp/org-clock.el
index 5338ee2..ce26a98 100644
--- a/lisp/org-clock.el
+++ b/lisp/org-clock.el
@@ -39,7 +39,6 @@
(defvar org-frame-title-format-backup frame-title-format)
(defvar org-time-stamp-formats)
-(defvar org-ts-what)
(defgroup org-clock nil
@@ -1669,11 +1668,11 @@ Optional argument N tells to change by that many units."
"Change CLOCK timestamps synchronously at cursor.
UPDOWN tells whether to change `up' or `down'.
Optional argument N tells to change by that many units."
- (setq org-ts-what nil)
- (when (org-at-timestamp-p t)
- (let ((tschange (if (eq updown 'up) 'org-timestamp-up
- 'org-timestamp-down))
- ts1 begts1 ts2 begts2 updatets1 tdiff)
+ (let ((tschange (if (eq updown 'up) 'org-timestamp-up
+ 'org-timestamp-down))
+ (timestamp? (org-at-timestamp-p t))
+ ts1 begts1 ts2 begts2 updatets1 tdiff)
+ (when timestamp?
(save-excursion
(move-beginning-of-line 1)
(re-search-forward org-ts-regexp3 nil t)
@@ -1685,7 +1684,6 @@ Optional argument N tells to change by that many units."
(if (not ts2)
;; fall back on org-timestamp-up if there is only one
(funcall tschange n)
- ;; setq this so that (boundp 'org-ts-what is non-nil)
(funcall tschange n)
(let ((ts (if updatets1 ts2 ts1))
(begts (if updatets1 begts1 begts2)))
@@ -1697,12 +1695,13 @@ Optional argument N tells to change by that many units."
(goto-char begts)
(org-timestamp-change
(round (/ (float-time tdiff)
- (cond ((eq org-ts-what 'minute) 60)
- ((eq org-ts-what 'hour) 3600)
- ((eq org-ts-what 'day) (* 24 3600))
- ((eq org-ts-what 'month) (* 24 3600 31))
- ((eq org-ts-what 'year) (* 24 3600 365.2)))))
- org-ts-what 'updown)))))))
+ (pcase timestamp?
+ (`minute 60)
+ (`hour 3600)
+ (`day (* 24 3600))
+ (`month (* 24 3600 31))
+ (`year (* 24 3600 365.2)))))
+ timestamp? 'updown)))))))
;;;###autoload
(defun org-clock-cancel ()
diff --git a/lisp/org.el b/lisp/org.el
index c287f00..52e6e8d 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -16689,7 +16689,6 @@ Return the position where this entry starts, or nil if there is no such entry."
(defvar org-last-changed-timestamp nil)
(defvar org-last-inserted-timestamp nil
"The last time stamp inserted with `org-insert-time-stamp'.")
-(defvar org-ts-what) ; dynamically scoped parameter
(defun org-time-stamp (arg &optional inactive)
"Prompt for a date/time and insert a time stamp.
@@ -17982,36 +17981,54 @@ inactive timestamps.
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-OK.
+
+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.
+
+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.,
+
+ (org-in-regexp org-ts-regexp)
+
+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))
(pos (point))
- (ans (or (looking-at tsr)
- (save-excursion
- (skip-chars-backward "^[<\n\r\t")
- (when (> (point) (point-min)) (backward-char 1))
- (and (looking-at tsr)
- (> (- (match-end 0) pos) -1))))))
- (and ans
- (boundp 'org-ts-what)
- (setq org-ts-what
- (cond
- ((= pos (match-beginning 0)) 'bracket)
- ;; Point is considered to be "on the bracket" whether
- ;; it's really on it or right after it.
- ((= pos (1- (match-end 0))) 'bracket)
- ((= pos (match-end 0)) 'after)
- ((org-pos-in-match-range pos 2) 'year)
- ((org-pos-in-match-range pos 3) 'month)
- ((org-pos-in-match-range pos 7) 'hour)
- ((org-pos-in-match-range pos 8) 'minute)
- ((or (org-pos-in-match-range pos 4)
- (org-pos-in-match-range pos 5)) 'day)
- ((and (> pos (or (match-end 8) (match-end 5)))
- (< pos (match-end 0)))
- (- pos (or (match-end 8) (match-end 5))))
- (t 'day))))
- ans))
+ (match
+ (let ((boundaries (org-in-regexp tsr)))
+ (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)))
+ (t
+ (eq 'timestamp
+ (save-excursion
+ (when (= pos (cdr boundaries)) (forward-char -1))
+ (org-element-type (org-element-context))))))))))
+ (cond
+ ((not match) nil)
+ ((= pos (match-beginning 0)) 'bracket)
+ ;; Distinguish location right before the closing bracket from
+ ;; right after it.
+ ((= pos (1- (match-end 0))) 'bracket)
+ ((= pos (match-end 0)) 'after)
+ ((org-pos-in-match-range pos 2) 'year)
+ ((org-pos-in-match-range pos 3) 'month)
+ ((org-pos-in-match-range pos 7) 'hour)
+ ((org-pos-in-match-range pos 8) 'minute)
+ ((or (org-pos-in-match-range pos 4)
+ (org-pos-in-match-range pos 5)) 'day)
+ ((and (> pos (or (match-end 8) (match-end 5)))
+ (< pos (match-end 0)))
+ (- pos (or (match-end 8) (match-end 5))))
+ (t 'day))))
(defun org-toggle-timestamp-type ()
"Toggle the type (<active> or [inactive]) of a time stamp."
@@ -18041,26 +18058,26 @@ The date will be changed by N times WHAT. WHAT can be `day', `month',
`year', `minute', `second'. If WHAT is not given, the cursor position
in the timestamp determines what will be changed.
When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
- (let ((origin (point)) origin-cat
+ (let ((origin (point))
+ (timestamp? (org-at-timestamp-p t))
+ origin-cat
with-hm inactive
(dm (max (nth 1 org-time-stamp-rounding-minutes) 1))
- org-ts-what
extra rem
ts time time0 fixnext clrgx)
- (unless (org-at-timestamp-p t)
- (user-error "Not at a timestamp"))
- (if (and (not what) (eq org-ts-what 'bracket))
+ (unless timestamp? (user-error "Not at a timestamp"))
+ (if (and (not what) (eq timestamp? 'bracket))
(org-toggle-timestamp-type)
;; Point isn't on brackets. Remember the part of the time-stamp
;; the point was in. Indeed, size of time-stamps may change,
;; but point must be kept in the same category nonetheless.
- (setq origin-cat org-ts-what)
- (when (and (not what) (not (eq org-ts-what 'day))
+ (setq origin-cat timestamp?)
+ (when (and (not what) (not (eq timestamp? 'day))
org-display-custom-times
(get-text-property (point) 'display)
(not (get-text-property (1- (point)) 'display)))
- (setq org-ts-what 'day))
- (setq org-ts-what (or what org-ts-what)
+ (setq timestamp? 'day))
+ (setq timestamp? (or what timestamp?)
inactive (= (char-after (match-beginning 0)) ?\[)
ts (match-string 0))
(replace-match "")
@@ -18074,7 +18091,7 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
(setq with-hm t))
(setq time0 (org-parse-time-string ts))
(when (and updown
- (eq org-ts-what 'minute)
+ (eq timestamp? 'minute)
(not current-prefix-arg))
;; This looks like s-up and s-down. Change by one rounding step.
(setq n (* dm (cond ((> n 0) 1) ((< n 0) -1) (t 0))))
@@ -18084,21 +18101,21 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
(setq time
(apply #'encode-time
(or (car time0) 0)
- (+ (if (eq org-ts-what 'minute) n 0) (nth 1 time0))
- (+ (if (eq org-ts-what 'hour) n 0) (nth 2 time0))
- (+ (if (eq org-ts-what 'day) n 0) (nth 3 time0))
- (+ (if (eq org-ts-what 'month) n 0) (nth 4 time0))
- (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0))
+ (+ (if (eq timestamp? 'minute) n 0) (nth 1 time0))
+ (+ (if (eq timestamp? 'hour) n 0) (nth 2 time0))
+ (+ (if (eq timestamp? 'day) n 0) (nth 3 time0))
+ (+ (if (eq timestamp? 'month) n 0) (nth 4 time0))
+ (+ (if (eq timestamp? 'year) n 0) (nth 5 time0))
(nthcdr 6 time0)))
- (when (and (member org-ts-what '(hour minute))
+ (when (and (memq timestamp? '(hour minute))
extra
(string-match "-\\([012][0-9]\\):\\([0-5][0-9]\\)" extra))
(setq extra (org-modify-ts-extra
extra
- (if (eq org-ts-what 'hour) 2 5)
+ (if (eq timestamp? 'hour) 2 5)
n dm)))
- (when (integerp org-ts-what)
- (setq extra (org-modify-ts-extra extra org-ts-what n dm)))
+ (when (integerp timestamp?)
+ (setq extra (org-modify-ts-extra extra timestamp? n dm)))
(when (eq what 'calendar)
(let ((cal-date (org-get-date-from-calendar)))
(setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month
@@ -18165,14 +18182,14 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
(when (re-search-forward clrgx nil t)
(goto-char (match-beginning 1))
(let (org-clock-adjust-closest)
- (org-timestamp-change n org-ts-what updown))
+ (org-timestamp-change n timestamp? updown))
(message "Clock adjusted in %s for heading: %s"
(file-name-nondirectory (buffer-file-name))
(org-get-heading t t)))))))))
;; Try to recenter the calendar window, if any.
(when (and org-calendar-follow-timestamp-change
(get-buffer-window "*Calendar*" t)
- (memq org-ts-what '(day month year)))
+ (memq timestamp? '(day month year)))
(org-recenter-calendar (time-to-days time))))))
(defun org-modify-ts-extra (s pos n dm)
@@ -20819,7 +20836,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-at-timestamp-p t))
+ (if (and (org-at-clock-log-p) (org-in-regexp org-ts-regexp-inactive))
(let (org-support-shift-select)
(org-clock-timestamps-up n))
(user-error "Not at a clock log")))
@@ -20828,7 +20845,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-at-timestamp-p t))
+ (if (and (org-at-clock-log-p) (org-in-regexp org-ts-regexp-inactive))
(let (org-support-shift-select)
(org-clock-timestamps-down n))
(user-error "Not at a clock log")))