masscollaborationlabs/emacs
2
0
Fork 0
mirror of https://github.com/masscollaborationlabs/emacs.git synced 2025-07-04 11:23:24 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Fix several todo-mode.el item editing bugs (bug#63811)

Browse source 
* lisp/calendar/todo-mode.el (todo-insert-item--basic): With
insertion type 'here', ensure item is inserted on the todo-mode
line where the command was invoked.
(todo-edit-item--cat, todo-edit-item--pos): New variables.
(todo-edit-item--text): Restrict the scope of nil-valued
buffer-read-only to the functions that change buffer text.  If
user moved point while editing a single-line todo item or a done
item comment, or while inserting a done item comment, restore
point, and for comments, make sure the done items section is
displayed.  For multiline items, set the new variables so
todo-edit-quit can use them.
(todo-edit-quit): Use the values of the new variables to restore
point in the todo-mode buffer if it had been moved while editing.
(todo-edit-item--header): Avoid clobbering match data when editing
a todo item header.
This commit is contained in:
Stephen Berman 2023-05-31 16:15:48 +02:00
parent ed4cd3eddf
commit 83b22139e4
1 changed files with 168 additions and 130 deletions
Download patch file Download diff file Expand all files Collapse all files

298
lisp/calendar/todo-mode.el
View file

@ -1985,7 +1985,13 @@ their associated keys and their effects."
(setq done-only t) (setq done-only t)
(todo-toggle-view-done-only)) (todo-toggle-view-done-only))
(if here (if here
(todo-insert-with-overlays new-item) (progn
;; Ensure item is inserted where command was invoked.
(unless (= (point) opoint)
(todo-category-number ocat)
(todo-category-select)
(goto-char opoint))
(todo-insert-with-overlays new-item))
(todo-set-item-priority new-item cat t)) (todo-set-item-priority new-item cat t))
(setq item-added t)) (setq item-added t))
;; If user cancels before setting priority, restore ;; If user cancels before setting priority, restore
@ -2119,6 +2125,9 @@ the item at point."
((or marked (todo-item-string)) ((or marked (todo-item-string))
(todo-edit-item--next-key 'todo arg))))) (todo-edit-item--next-key 'todo arg)))))
(defvar todo-edit-item--cat nil)
(defvar todo-edit-item--pos nil)
(defun todo-edit-item--text (&optional arg) (defun todo-edit-item--text (&optional arg)
"Function providing the text editing facilities of `todo-edit-item'." "Function providing the text editing facilities of `todo-edit-item'."
(let ((full-item (todo-item-string))) (let ((full-item (todo-item-string)))
@ -2127,6 +2136,7 @@ the item at point."
;; 1+ signals an error, so just make this a noop. ;; 1+ signals an error, so just make this a noop.
(when full-item (when full-item
(let* ((opoint (point)) (let* ((opoint (point))
(ocat (todo-current-category))
(start (todo-item-start)) (start (todo-item-start))
(end (save-excursion (todo-item-end))) (end (save-excursion (todo-item-end)))
(item-beg (progn (item-beg (progn
@ -2151,8 +2161,7 @@ the item at point."
(concat " \\[" (regexp-quote todo-comment-string) (concat " \\[" (regexp-quote todo-comment-string)
": \\([^]]+\\)\\]") ": \\([^]]+\\)\\]")
end t))) end t)))
(prompt (if comment "Edit comment: " "Enter a comment: ")) (prompt (if comment "Edit comment: " "Enter a comment: ")))
(buffer-read-only nil))
;; When there are marked items, user can invoke todo-edit-item ;; When there are marked items, user can invoke todo-edit-item
;; even if point is not on an item, but text editing only ;; even if point is not on an item, but text editing only
;; applies to the item at point. ;; applies to the item at point.
@ -2170,22 +2179,43 @@ the item at point."
end t) end t)
(if comment-delete (if comment-delete
(when (todo-y-or-n-p "Delete comment? ") (when (todo-y-or-n-p "Delete comment? ")
(delete-region (match-beginning 0) (match-end 0))) (let ((buffer-read-only nil))
(replace-match (save-match-data (delete-region (match-beginning 0) (match-end 0))))
(read-string prompt (let ((buffer-read-only nil))
(cons (match-string 1) 1))) (replace-match (save-match-data
nil nil nil 1)) (prog1 (let ((buffer-read-only t))
(read-string
prompt
(cons (match-string 1) 1)))
;; If user moved point while editing
;; a comment, restore it and ensure
;; done items section is displayed.
(unless (= (point) opoint)
(todo-category-number ocat)
(let ((todo-show-with-done t))
(todo-category-select)
(goto-char opoint)))))
nil nil nil 1)))
(if comment-delete (if comment-delete
(user-error "There is no comment to delete") (user-error "There is no comment to delete")
(insert " [" todo-comment-string ": " (let ((buffer-read-only nil))
(prog1 (read-string prompt) (insert " [" todo-comment-string ": "
;; If user moved point during editing, (prog1 (let ((buffer-read-only t))
;; make sure it moves back. (read-string prompt))
(goto-char opoint) ;; If user moved point while inserting a
(todo-item-end)) ;; comment, restore it and ensure done items
"]"))))) ;; section is displayed.
(unless (= (point) opoint)
(todo-category-number ocat)
(let ((todo-show-with-done t))
(todo-category-select)
(goto-char opoint)))
(todo-item-end))
"]"))))))
(multiline (multiline
(let ((buf todo-edit-buffer)) (let ((buf todo-edit-buffer))
(setq todo-edit-item--cat ocat)
(setq todo-edit-item--pos opoint)
(set-window-buffer (selected-window) (set-window-buffer (selected-window)
(set-buffer (make-indirect-buffer (set-buffer (make-indirect-buffer
(buffer-name) buf))) (buffer-name) buf)))
@ -2208,10 +2238,14 @@ the item at point."
;; Ensure lines following hard newlines are indented. ;; Ensure lines following hard newlines are indented.
(setq new (replace-regexp-in-string "\\(\n\\)[^[:blank:]]" (setq new (replace-regexp-in-string "\\(\n\\)[^[:blank:]]"
"\n\t" new nil nil 1)) "\n\t" new nil nil 1))
;; If user moved point during editing, make sure it moves back. ;; If user moved point while editing item, restore it.
(goto-char opoint) (unless (= (point) opoint)
(todo-remove-item) (todo-category-number ocat)
(todo-insert-with-overlays new) (todo-category-select)
(goto-char opoint))
(let ((buffer-read-only nil))
(todo-remove-item)
(todo-insert-with-overlays new))
(move-to-column item-beg))))))))) (move-to-column item-beg)))))))))
(defun todo-edit-quit () (defun todo-edit-quit ()
@ -2243,6 +2277,9 @@ made in the number or names of categories."
(kill-buffer) (kill-buffer)
(unless (eq (current-buffer) buf) (unless (eq (current-buffer) buf)
(set-window-buffer (selected-window) (set-buffer buf))) (set-window-buffer (selected-window) (set-buffer buf)))
(todo-category-number todo-edit-item--cat)
(todo-category-select)
(goto-char todo-edit-item--pos)
(if transient-mark-mode (deactivate-mark))) (if transient-mark-mode (deactivate-mark)))
;; We got here via `F e'. ;; We got here via `F e'.
(when (todo-check-format) (when (todo-check-format)
@ -2315,117 +2352,118 @@ made in the number or names of categories."
;; If there are marked items, use only the first to set ;; If there are marked items, use only the first to set
;; header changes, and apply these to all marked items. ;; header changes, and apply these to all marked items.
(when first (when first
(cond (save-match-data
((eq what 'date) (cond
(setq ndate (todo-read-date))) ((eq what 'date)
((eq what 'calendar) (setq ndate (todo-read-date)))
(setq ndate (save-match-data (todo-set-date-from-calendar)))) ((eq what 'calendar)
((eq what 'today) (setq ndate (todo-set-date-from-calendar)))
(setq ndate (calendar-date-string (calendar-current-date) t t))) ((eq what 'today)
((eq what 'dayname) (setq ndate (calendar-date-string (calendar-current-date) t t)))
(setq ndate (todo-read-dayname))) ((eq what 'dayname)
((eq what 'time) (setq ndate (todo-read-dayname)))
(setq ntime (save-match-data (todo-read-time))) ((eq what 'time)
(when (> (length ntime) 0) (setq ntime (todo-read-time))
(setq ntime (concat " " ntime)))) (when (> (length ntime) 0)
;; When date string consists only of a day name, (setq ntime (concat " " ntime))))
;; passing other date components is a noop. ;; When date string consists only of a day name,
((and odayname (memq what '(year month day)))) ;; passing other date components is a noop.
((eq what 'year) ((and odayname (memq what '(year month day))))
(setq day oday ((eq what 'year)
monthname omonthname (setq day oday
month omonth monthname omonthname
year (cond ((not current-prefix-arg) month omonth
(todo-read-date 'year)) year (cond ((not current-prefix-arg)
((string= oyear "*") (todo-read-date 'year))
(user-error "Cannot increment *")) ((string= oyear "*")
(t (user-error "Cannot increment *"))
(number-to-string (+ yy inc)))))) (t
((eq what 'month) (number-to-string (+ yy inc))))))
(setf day oday ((eq what 'month)
year oyear (setf day oday
(if (memq 'month calendar-date-display-form) year oyear
month (if (memq 'month calendar-date-display-form)
monthname) month
(cond ((not current-prefix-arg) monthname)
(todo-read-date 'month)) (cond ((not current-prefix-arg)
((or (string= omonth "*") (= mm 13)) (todo-read-date 'month))
(user-error "Cannot increment *")) ((or (string= omonth "*") (= mm 13))
(t (user-error "Cannot increment *"))
(let* ((mmo mm) (t
;; Change by 12 or more months? (let* ((mmo mm)
(bigincp (>= (abs inc) 12)) ;; Change by 12 or more months?
;; Month number is in range 1..12. (bigincp (>= (abs inc) 12))
(mminc (+ mm (% inc 12))) ;; Month number is in range 1..12.
(mm (% (+ mminc 12) 12)) (mminc (+ mm (% inc 12)))
;; 12n mod 12 = 0, so 0 is December. (mm (% (+ mminc 12) 12))
(mm (if (= mm 0) 12 mm)) ;; 12n mod 12 = 0, so 0 is December.
;; Does change in month cross year? (mm (if (= mm 0) 12 mm))
(mmcmp (cond ((< inc 0) (> mm mmo)) ;; Does change in month cross year?
((> inc 0) (< mm mmo)))) (mmcmp (cond ((< inc 0) (> mm mmo))
(yyadjust (if bigincp ((> inc 0) (< mm mmo))))
(+ (abs (/ inc 12)) (yyadjust (if bigincp
(if mmcmp 1 0)) (+ (abs (/ inc 12))
1))) (if mmcmp 1 0))
;; Adjust year if necessary. 1)))
(setq yy (cond ((and (< inc 0) ;; Adjust year if necessary.
(or mmcmp bigincp)) (setq yy (cond ((and (< inc 0)
(- yy yyadjust)) (or mmcmp bigincp))
((and (> inc 0) (- yy yyadjust))
(or mmcmp bigincp)) ((and (> inc 0)
(+ yy yyadjust)) (or mmcmp bigincp))
(t yy))) (+ yy yyadjust))
(setq year (number-to-string yy)) (t yy)))
;; Return the changed numerical month as (setq year (number-to-string yy))
;; a string or the corresponding month name. ;; Return the changed numerical month as
(if omonth ;; a string or the corresponding month name.
(number-to-string mm) (if omonth
(aref tma-array (1- mm))))))) (number-to-string mm)
;; Since the number corresponding to the arbitrary (aref tma-array (1- mm)))))))
;; month name "*" is out of the range of ;; Since the number corresponding to the arbitrary
;; calendar-last-day-of-month, set it to 1 ;; month name "*" is out of the range of
;; (corresponding to January) to allow 31 days. ;; calendar-last-day-of-month, set it to 1
(let ((mm (if (= mm 13) 1 mm))) ;; (corresponding to January) to allow 31 days.
(if (> (string-to-number day) (let ((mm (if (= mm 13) 1 mm)))
(calendar-last-day-of-month mm yy)) (if (> (string-to-number day)
(user-error "%s %s does not have %s days" (calendar-last-day-of-month mm yy))
(aref tmn-array (1- mm)) (user-error "%s %s does not have %s days"
(if (= mm 2) yy "") day)))) (aref tmn-array (1- mm))
((eq what 'day) (if (= mm 2) yy "") day))))
(setq year oyear ((eq what 'day)
month omonth (setq year oyear
monthname omonthname month omonth
day (cond monthname omonthname
((not current-prefix-arg) day (cond
(todo-read-date 'day mm yy)) ((not current-prefix-arg)
((string= oday "*") (todo-read-date 'day mm yy))
(user-error "Cannot increment *")) ((string= oday "*")
((or (string= omonth "*") (string= omonthname "*")) (user-error "Cannot increment *"))
(setq dd (+ dd inc)) ((or (string= omonth "*") (string= omonthname "*"))
(if (> dd 31) (setq dd (+ dd inc))
(user-error (if (> dd 31)
"A month cannot have more than 31 days") (user-error
(number-to-string dd))) "A month cannot have more than 31 days")
;; Increment or decrement day by INC, (number-to-string dd)))
;; adjusting month and year if necessary ;; Increment or decrement day by INC,
;; (if year is "*" assume current year to ;; adjusting month and year if necessary
;; calculate adjustment). ;; (if year is "*" assume current year to
(t ;; calculate adjustment).
(let* ((yy (or yy (calendar-extract-year (t
(calendar-current-date)))) (let* ((yy (or yy (calendar-extract-year
(date (calendar-gregorian-from-absolute (calendar-current-date))))
(+ (calendar-absolute-from-gregorian (date (calendar-gregorian-from-absolute
(list mm dd yy)) (+ (calendar-absolute-from-gregorian
inc))) (list mm dd yy))
(adjmm (nth 0 date))) inc)))
;; Set year and month(name) to adjusted values. (adjmm (nth 0 date)))
(unless (string= year "*") ;; Set year and month(name) to adjusted values.
(setq year (number-to-string (nth 2 date)))) (unless (string= year "*")
(if month (setq year (number-to-string (nth 2 date))))
(setq month (number-to-string adjmm)) (if month
(setq monthname (aref tma-array (1- adjmm)))) (setq month (number-to-string adjmm))
;; Return changed numerical day as a string. (setq monthname (aref tma-array (1- adjmm))))
(number-to-string (nth 1 date))))))))) ;; Return changed numerical day as a string.
(number-to-string (nth 1 date))))))))))
(unless odayname (unless odayname
;; If year, month or day date string components were ;; If year, month or day date string components were
;; changed, rebuild the date string. ;; changed, rebuild the date string.