Function: org-auto-repeat-maybe

org-auto-repeat-maybe is a byte-compiled function defined in org.el.gz.

Signature

(org-auto-repeat-maybe DONE-WORD)

Documentation

Check if the current headline contains a repeated timestamp.

If yes, set TODO state back to what it was and change the base date of repeating deadline/scheduled time stamps to new date.

This function is run automatically after each state change to a DONE state.

Source Code

;; Defined in /usr/src/emacs/lisp/org/org.el.gz
(defun org-auto-repeat-maybe (done-word)
  "Check if the current headline contains a repeated timestamp.

If yes, set TODO state back to what it was and change the base date
of repeating deadline/scheduled time stamps to new date.

This function is run automatically after each state change to a DONE state."
  (let* ((repeat (org-get-repeat))
	 (aa (assoc org-last-state org-todo-kwd-alist))
	 (interpret (nth 1 aa))
	 (head (nth 2 aa))
	 (whata '(("h" . hour) ("d" . day) ("m" . month) ("y" . year)))
	 (msg "Entry repeats: ")
	 (org-log-done nil)
	 (org-todo-log-states nil)
	 (end (copy-marker (org-entry-end-position))))
    (when (and repeat (not (= 0 (string-to-number (substring repeat 1)))))
      (when (eq org-log-repeat t) (setq org-log-repeat 'state))
      (let ((to-state
             (or (org-entry-get nil "REPEAT_TO_STATE" 'selective)
		 (and (stringp org-todo-repeat-to-state)
		      org-todo-repeat-to-state)
		 (and org-todo-repeat-to-state org-last-state))))
	(org-todo (cond ((and to-state (member to-state org-todo-keywords-1))
			 to-state)
			((eq interpret 'type) org-last-state)
			(head)
			(t 'none))))
      (org-back-to-heading t)
      (org-add-planning-info nil nil 'closed)
      ;; When `org-log-repeat' is non-nil or entry contains
      ;; a clock, set LAST_REPEAT property.
      (when (or org-log-repeat
		(catch :clock
		  (save-excursion
		    (while (re-search-forward org-clock-line-re end t)
		      (when (org-at-clock-log-p) (throw :clock t))))))
	(org-entry-put nil "LAST_REPEAT" (format-time-string
					  (org-time-stamp-format t t)
                                          (org-current-effective-time))))
      (when org-log-repeat
	(if org-log-setup
	    ;; We are already setup for some record.
	    (when (eq org-log-repeat 'note)
	      ;; Make sure we take a note, not only a time stamp.
	      (setq org-log-note-how 'note))
	  ;; Set up for taking a record.
	  (org-add-log-setup 'state
			     (or done-word (car org-done-keywords))
			     org-last-state
			     org-log-repeat)))
      ;; Timestamps without a repeater are usually skipped.  However,
      ;; a SCHEDULED timestamp without one is removed, as they are no
      ;; longer relevant.
      (save-excursion
	(let ((scheduled (org-entry-get (point) "SCHEDULED")))
	  (when (and scheduled (not (string-match-p org-repeat-re scheduled)))
	    (org-remove-timestamp-with-keyword org-scheduled-string))))
      ;; Update every timestamp with a repeater in the entry.
      (let ((planning-re (regexp-opt
			  (list org-scheduled-string org-deadline-string))))
	(while (re-search-forward org-repeat-re end t)
	  (let* ((ts (match-string 0))
		 (type (if (not (org-at-planning-p)) "Plain:"
			 (save-excursion
			   (re-search-backward
			    planning-re (line-beginning-position) t)
			   (match-string 0)))))
	    (when (and (org-at-timestamp-p 'agenda)
		       (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts))
	      (let ((n (string-to-number (match-string 2 ts)))
		    (what (match-string 3 ts)))
		(when (equal what "w") (setq n (* n 7) what "d"))
		(when (and (equal what "h")
			   (not (string-match-p "[0-9]\\{1,2\\}:[0-9]\\{2\\}"
						ts)))
		  (user-error
		   "Cannot repeat in %d hour(s) because no hour has been set"
		   n))
		;; Preparation, see if we need to modify the start
		;; date for the change.
		(when (match-end 1)
		  (let ((time (save-match-data (org-time-string-to-time ts)))
			(repeater-type (match-string 1 ts)))
		    (cond
		     ((equal "." repeater-type)
		      ;; Shift starting date to today, or now if
		      ;; repeater is by hours.
		      (if (equal what "h")
			  (org-timestamp-change
			   (floor (- (org-timestamp-to-now ts t)) 60) 'minute)
			(org-timestamp-change
			 (- (org-today) (time-to-days time)) 'day)))
		     ((equal "+" repeater-type)
		      (let ((nshiftmax 10)
			    (nshift 0))
			(while (or (= nshift 0)
				   (if (equal what "h")
				       (not (time-less-p nil time))
				     (>= (org-today)
					 (time-to-days time))))
			  (when (= nshiftmax (cl-incf nshift))
			    (or (y-or-n-p
				 (format "%d repeater intervals were not \
enough to shift date past today.  Continue? "
					 nshift))
				(user-error "Abort")))
			  (org-timestamp-change n (cdr (assoc what whata)))
			  (org-in-regexp org-ts-regexp3)
			  (setq ts (match-string 1))
			  (setq time
				(save-match-data
				  (org-time-string-to-time ts)))))
		      (org-timestamp-change (- n) (cdr (assoc what whata)))
		      ;; Rematch, so that we have everything in place
		      ;; for the real shift.
		      (org-in-regexp org-ts-regexp3)
		      (setq ts (match-string 1))
		      (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)"
				    ts)))))
		(save-excursion
		  (org-timestamp-change n (cdr (assoc what whata)) nil t))
		(setq msg
		      (concat msg type " " org-last-changed-timestamp " ")))))))
      (run-hooks 'org-todo-repeat-hook)
      (setq org-log-post-message msg)
      (message msg))))