Function: org-timestamp-change

org-timestamp-change is a byte-compiled function defined in org.el.gz.

Signature

(org-timestamp-change N &optional WHAT UPDOWN SUPPRESS-TMP-DELAY)

Documentation

Change the date in the time stamp at point.

The date is changed by N times WHAT. WHAT can be day, month, year, hour, or minute. If WHAT is not given, the cursor position in the timestamp determines what is changed.

When optional argument UPDOWN is non-nil, minutes are rounded according to org-time-stamp-rounding-minutes.

When SUPPRESS-TMP-DELAY is non-nil, suppress delays like
"--2d".

Source Code

;; Defined in /usr/src/emacs/lisp/org/org.el.gz
(defvar org-clock-adjust-closest nil)          ; defined in org-clock.el
(defun org-timestamp-change (n &optional what updown suppress-tmp-delay)
  "Change the date in the time stamp at point.

The date is changed by N times WHAT.  WHAT can be `day', `month',
`year', `hour', or `minute'.  If WHAT is not given, the cursor
position in the timestamp determines what is changed.

When optional argument UPDOWN is non-nil, minutes are rounded
according to `org-time-stamp-rounding-minutes'.

When SUPPRESS-TMP-DELAY is non-nil, suppress delays like
\"--2d\"."
  (let ((origin (point))
	(timestamp? (org-at-timestamp-p 'lax))
	origin-cat
	with-hm inactive
	(dm (max (nth 1 org-time-stamp-rounding-minutes) 1))
	extra rem
	ts time time0 fixnext clrgx)
    (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 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 timestamp? 'day))
      (setq timestamp? (or what timestamp?)
	    inactive (= (char-after (match-beginning 0)) ?\[)
	    ts (match-string 0))
      (replace-match "")
      (when (string-match
	     "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( +[.+]?-?[-+][0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)*\\)[]>]"
	     ts)
	(setq extra (match-string 1 ts))
	(when suppress-tmp-delay
	  (setq extra (replace-regexp-in-string " --[0-9]+[hdwmy]" "" extra))))
      (when (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts)
	(setq with-hm t))
      (setq time0 (org-parse-time-string ts))
      (when (and updown
		 (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))))
	(unless (= 0 (setq rem (% (nth 1 time0) dm)))
	  (setcar (cdr time0) (+ (nth 1 time0)
				 (if (> n 0) (- rem) (- dm rem))))))
      (setq time
	    (org-encode-time
             (apply #'list
                    (or (car time0) 0)
                    (+ (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 (memq timestamp? '(hour minute))
		 extra
		 (string-match "-\\([012][0-9]\\):\\([0-5][0-9]\\)" extra))
	(setq extra (org-modify-ts-extra
		     extra
		     (if (eq timestamp? 'hour) 2 5)
		     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
	  (setcar (nthcdr 3 time0) (nth 1 cal-date)) ; day
	  (setcar (nthcdr 5 time0) (nth 2 cal-date)) ; year
	  (setcar time0 (or (car time0) 0))
	  (setcar (nthcdr 1 time0) (or (nth 1 time0) 0))
	  (setcar (nthcdr 2 time0) (or (nth 2 time0) 0))
	  (setq time (org-encode-time time0))))
      ;; Insert the new time-stamp, and ensure point stays in the same
      ;; category as before (i.e. not after the last position in that
      ;; category).
      (let ((pos (point)))
	;; Stay before inserted string. `save-excursion' is of no use.
	(setq org-last-changed-timestamp
	      (org-insert-time-stamp time with-hm inactive nil nil extra))
	(goto-char pos))
      (save-match-data
	(looking-at org-ts-regexp3)
	(goto-char
	 (pcase origin-cat
	   ;; `day' category ends before `hour' if any, or at the end
	   ;; of the day name.
	   (`day (min (or (match-beginning 7) (1- (match-end 5))) origin))
	   (`hour (min (match-end 7) origin))
	   (`minute (min (1- (match-end 8)) origin))
	   ((pred integerp) (min (1- (match-end 0)) origin))
	   ;; Point was right after the time-stamp.  However, the
	   ;; time-stamp length might have changed, so refer to
	   ;; (match-end 0) instead.
	   (`after (match-end 0))
	   ;; `year' and `month' have both fixed size: point couldn't
	   ;; have moved into another part.
	   (_ origin))))
      ;; Update clock if on a CLOCK line.
      (org-clock-update-time-maybe)
      ;; Maybe adjust the closest clock in `org-clock-history'
      (when org-clock-adjust-closest
	(if (not (and (org-at-clock-log-p)
		      (< 1 (length (delq nil (mapcar 'marker-position
						     org-clock-history))))))
	    (message "No clock to adjust")
	  (cond ((save-excursion	; fix previous clock?
		   (re-search-backward org-ts-regexp0 nil t)
		   (looking-back (concat org-clock-string " \\[")
				 (line-beginning-position)))
		 (setq fixnext 1 clrgx (concat org-ts-regexp0 "\\] =>.*$")))
		((save-excursion	; fix next clock?
		   (re-search-backward org-ts-regexp0 nil t)
		   (looking-at (concat org-ts-regexp0 "\\] =>")))
		 (setq fixnext -1 clrgx (concat org-clock-string " \\[" org-ts-regexp0))))
	  (save-window-excursion
	    ;; Find closest clock to point, adjust the previous/next one in history
	    (let* ((p (save-excursion (org-back-to-heading t)))
		   (cl (mapcar (lambda(c) (abs (- (marker-position c) p))) org-clock-history))
		   (clfixnth
		    (+ fixnext (- (length cl) (or (length (member (apply 'min cl) cl)) 100))))
		   (clfixpos (unless (> 0 clfixnth) (nth clfixnth org-clock-history))))
	      (if (not clfixpos)
		  (message "No clock to adjust")
		(save-excursion
		  (org-goto-marker-or-bmk clfixpos)
		  (org-fold-show-subtree)
		  (when (re-search-forward clrgx nil t)
		    (goto-char (match-beginning 1))
		    (let (org-clock-adjust-closest)
		      (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 timestamp? '(day month year)))
	(org-recenter-calendar (time-to-days time))))))