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))
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))
(mngroup (string-to-number
(alist-get 'monthname todo--date-pattern-groups)))
(omonthname (match-string-no-properties mngroup))
(mgroup (string-to-number
(alist-get 'month todo--date-pattern-groups)))
(omonth (match-string-no-properties mgroup))
(dgroup (string-to-number
(alist-get 'day todo--date-pattern-groups)))
(oday (match-string-no-properties dgroup))
(ygroup (string-to-number
(alist-get 'year todo--date-pattern-groups)))
(oyear (match-string-no-properties ygroup))
(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
(save-match-data
(cond
((eq what 'date)
(setq ndate (todo-read-date)))
((eq what 'calendar)
(setq ndate (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 (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
;; With default ISO style, 'month is in a
;; sublist of c-d-d-f, so we flatten it.
(if (memq 'month (flatten-tree
calendar-date-display-form))
month
monthname)
(cond ((not current-prefix-arg)
(let ((nmonth (todo-read-date 'month)))
;; If old month is given as a number,
;; have to convert new month name to
;; the corresponding number.
(when omonth
(setq nmonth
(number-to-string
(1+ (seq-position tma-array
nmonth)))))
nmonth))
((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)))))
(let ((inhibit-read-only t))
(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))))))))