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-timestamp-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-timestamp-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-timestamp-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 timestamp
      ;; the point was in.  Indeed, size of timestamps 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))
      ;; FIXME: Instead of deleting everything and then inserting
      ;; later, we should make use of `replace-match', which preserves
      ;; markers.  The current implementation suffers from
      ;; `save-excursion' not preserving point inside the timestamp
      ;; once we delete the timestamp here.  The point moves to the
      ;; updated timestamp end.
      (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))
      (let ((increment n))
        (if (and updown
                 (eq timestamp? 'minute)
                 (not current-prefix-arg))
	    ;; This looks like s-up and s-down.  Change by one rounding step.
            (progn
	      (setq increment (* 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))))))
          ;; Do not round anything in `org-modify-ts-extra' when prefix
          ;; argument is supplied - just use whatever is provided by the
          ;; prefix argument.
          (setq dm 1))
        (setq time
	      (org-encode-time
               (apply #'list
                      (or (car time0) 0)
                      (+ (if (eq timestamp? 'minute) increment 0) (nth 1 time0))
                      (+ (if (eq timestamp? 'hour) increment 0)   (nth 2 time0))
                      (+ (if (eq timestamp? 'day) increment 0)    (nth 3 time0))
                      (+ (if (eq timestamp? 'month) increment 0)  (nth 4 time0))
                      (+ (if (eq timestamp? 'year) increment 0)   (nth 5 time0))
                      (nthcdr 6 time0)))))
      (when (and (memq timestamp? '(hour minute))
		 extra
		 (string-match "-\\([012][0-9]\\):\\([0-5][0-9]\\)" extra))
        ;; When modifying the start time in HH:MM-HH:MM range, update
        ;; end time as well.
	(setq extra (org-modify-ts-extra
		     extra ;; -HH:MM ...
                     ;; Fake position in EXTRA to force changing hours
                     ;; or minutes as needed.
		     (if (eq timestamp? 'hour)
                         2 ;; -H<H>:MM
                       5) ;; -HH:M<M>
		     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 timestamp, 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-timestamp 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 timestamp.  However, the
	   ;; timestamp 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-buffer t)
		 (memq timestamp? '(day month year)))
	(org-recenter-calendar (time-to-days time))))))