Function: todo-edit-item--header
todo-edit-item--header is a byte-compiled function defined in
todo-mode.el.gz.
Signature
(todo-edit-item--header WHAT &optional INC)
Documentation
Function providing header editing facilities of todo-edit-item.
Source Code
;; Defined in /usr/src/emacs/lisp/calendar/todo-mode.el.gz
(defun todo-edit-item--header (what &optional inc)
"Function providing header editing facilities of `todo-edit-item'."
(let ((marked (assoc (todo-current-category) todo-categories-with-marks))
(first t)
(todo-date-from-calendar t)
;; INC must be an integer, but users could pass it via
;; `todo-edit-item' as e.g. `-' or `C-u'.
(inc (prefix-numeric-value inc))
(buffer-read-only nil)
ndate ntime
year monthname month day) ;; dayname
(when marked (todo--user-error-if-marked-done-item))
(save-excursion
(or (and marked (goto-char (point-min))) (todo-item-start))
(catch 'end
(while (not (eobp))
(and marked
(while (not (todo-marked-item-p))
(todo-forward-item)
(and (eobp) (throw 'end nil))))
(re-search-forward (concat todo-date-string-start "\\(?1:"
todo-date-pattern
"\\)\\(?2: " diary-time-regexp "\\)?"
(regexp-quote todo-nondiary-end) "?")
(line-end-position) t)
(let* ((otime (match-string-no-properties 2))
(odayname (match-string-no-properties 5))
(omonthname (match-string-no-properties 6))
(omonth (match-string-no-properties 7))
(oday (match-string-no-properties 8))
(oyear (match-string-no-properties 9))
(tmn-array todo-month-name-array)
(mlist (append tmn-array nil))
(tma-array todo-month-abbrev-array)
(mablist (append tma-array nil))
(yy (and oyear (string-to-number oyear))) ; 0 if year is "*".
(mm (or (and omonth (if (string= omonth "*") 13
(string-to-number omonth)))
(1+ (- (length mlist)
(length (or (member omonthname mlist)
(member omonthname mablist)))))))
(dd (and oday (unless (string= oday "*")
(string-to-number oday)))))
;; If there are marked items, use only the first to set
;; header changes, and apply these to all marked items.
(when first
(cond
((eq what 'date)
(setq ndate (todo-read-date)))
((eq what 'calendar)
(setq ndate (save-match-data (todo-set-date-from-calendar))))
((eq what 'today)
(setq ndate (calendar-date-string (calendar-current-date) t t)))
((eq what 'dayname)
(setq ndate (todo-read-dayname)))
((eq what 'time)
(setq ntime (save-match-data (todo-read-time)))
(when (> (length ntime) 0)
(setq ntime (concat " " ntime))))
;; When date string consists only of a day name,
;; passing other date components is a noop.
((and odayname (memq what '(year month day))))
((eq what 'year)
(setq day oday
monthname omonthname
month omonth
year (cond ((not current-prefix-arg)
(todo-read-date 'year))
((string= oyear "*")
(user-error "Cannot increment *"))
(t
(number-to-string (+ yy inc))))))
((eq what 'month)
(setf day oday
year oyear
(if (memq 'month calendar-date-display-form)
month
monthname)
(cond ((not current-prefix-arg)
(todo-read-date 'month))
((or (string= omonth "*") (= mm 13))
(user-error "Cannot increment *"))
(t
(let* ((mmo mm)
;; Change by 12 or more months?
(bigincp (>= (abs inc) 12))
;; Month number is in range 1..12.
(mminc (+ mm (% inc 12)))
(mm (% (+ mminc 12) 12))
;; 12n mod 12 = 0, so 0 is December.
(mm (if (= mm 0) 12 mm))
;; Does change in month cross year?
(mmcmp (cond ((< inc 0) (> mm mmo))
((> inc 0) (< mm mmo))))
(yyadjust (if bigincp
(+ (abs (/ inc 12))
(if mmcmp 1 0))
1)))
;; Adjust year if necessary.
(setq yy (cond ((and (< inc 0)
(or mmcmp bigincp))
(- yy yyadjust))
((and (> inc 0)
(or mmcmp bigincp))
(+ yy yyadjust))
(t yy)))
(setq year (number-to-string yy))
;; Return the changed numerical month as
;; a string or the corresponding month name.
(if omonth
(number-to-string mm)
(aref tma-array (1- mm)))))))
;; Since the number corresponding to the arbitrary
;; month name "*" is out of the range of
;; calendar-last-day-of-month, set it to 1
;; (corresponding to January) to allow 31 days.
(let ((mm (if (= mm 13) 1 mm)))
(if (> (string-to-number day)
(calendar-last-day-of-month mm yy))
(user-error "%s %s does not have %s days"
(aref tmn-array (1- mm))
(if (= mm 2) yy "") day))))
((eq what 'day)
(setq year oyear
month omonth
monthname omonthname
day (cond
((not current-prefix-arg)
(todo-read-date 'day mm yy))
((string= oday "*")
(user-error "Cannot increment *"))
((or (string= omonth "*") (string= omonthname "*"))
(setq dd (+ dd inc))
(if (> dd 31)
(user-error
"A month cannot have more than 31 days")
(number-to-string dd)))
;; Increment or decrement day by INC,
;; adjusting month and year if necessary
;; (if year is "*" assume current year to
;; calculate adjustment).
(t
(let* ((yy (or yy (calendar-extract-year
(calendar-current-date))))
(date (calendar-gregorian-from-absolute
(+ (calendar-absolute-from-gregorian
(list mm dd yy))
inc)))
(adjmm (nth 0 date)))
;; Set year and month(name) to adjusted values.
(unless (string= year "*")
(setq year (number-to-string (nth 2 date))))
(if month
(setq month (number-to-string adjmm))
(setq monthname (aref tma-array (1- adjmm))))
;; Return changed numerical day as a string.
(number-to-string (nth 1 date)))))))))
(unless odayname
;; If year, month or day date string components were
;; changed, rebuild the date string.
(when (memq what '(year month day))
(setq ndate
(calendar-dlet
;; Needed by calendar-date-display-form.
((year year)
(monthname monthname)
(month month)
(day day)
(dayname nil)) ;; dayname
(mapconcat #'eval calendar-date-display-form "")))))
(when ndate (replace-match ndate nil nil nil 1))
;; Add new time string to the header, if it was supplied.
(when ntime
(if otime
(replace-match ntime nil nil nil 2)
(goto-char (match-end 1))
(insert ntime)))
(setq todo-date-from-calendar nil)
(setq first nil))
;; Apply the changes to the first marked item header to the
;; remaining marked items. If there are no marked items,
;; we're finished.
(if marked
(todo-forward-item)
(goto-char (point-max))))))))