From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Stephen Berman Newsgroups: gmane.emacs.bugs Subject: bug#63811: 29.0.91; todo-mode item editing bugs Date: Wed, 31 May 2023 11:12:32 +0200 Message-ID: <87zg5k985b.fsf@gmx.net> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="15747"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) To: 63811@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Wed May 31 11:13:21 2023 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1q4HtP-0003rK-DK for geb-bug-gnu-emacs@m.gmane-mx.org; Wed, 31 May 2023 11:13:19 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1q4Ht9-0001qN-G4; Wed, 31 May 2023 05:13:03 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1q4Ht8-0001qE-L5 for bug-gnu-emacs@gnu.org; Wed, 31 May 2023 05:13:02 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1q4Ht8-0003UC-CP for bug-gnu-emacs@gnu.org; Wed, 31 May 2023 05:13:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1q4Ht8-0007z4-54 for bug-gnu-emacs@gnu.org; Wed, 31 May 2023 05:13:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Stephen Berman Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Wed, 31 May 2023 09:13:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 63811 X-GNU-PR-Package: emacs X-Debbugs-Original-To: bug-gnu-emacs@gnu.org Original-Received: via spool by submit@debbugs.gnu.org id=B.168552436430663 (code B ref -1); Wed, 31 May 2023 09:13:01 +0000 Original-Received: (at submit) by debbugs.gnu.org; 31 May 2023 09:12:44 +0000 Original-Received: from localhost ([127.0.0.1]:34880 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1q4Hsp-0007yU-Oq for submit@debbugs.gnu.org; Wed, 31 May 2023 05:12:44 -0400 Original-Received: from lists.gnu.org ([209.51.188.17]:55358) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1q4Hsm-0007yK-04 for submit@debbugs.gnu.org; Wed, 31 May 2023 05:12:42 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1q4Hsl-0001ly-PX for bug-gnu-emacs@gnu.org; Wed, 31 May 2023 05:12:39 -0400 Original-Received: from mout.gmx.net ([212.227.17.21]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1q4Hsi-0003R1-MD for bug-gnu-emacs@gnu.org; Wed, 31 May 2023 05:12:39 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=gmx.net; s=s31663417; t=1685524353; i=stephen.berman@gmx.net; bh=dake0nW7/cXEnJX/oS5eodfd514PGmUcp18YqnmLLL4=; h=X-UI-Sender-Class:From:To:Subject:Date; b=QSlMIq6aTHoyX8nQ9WB91a/JFJr6rIINrib1hcUsQRDEKw32cgK5p0ADyZO5AvXkT qdn1wwZC8YVW3VO37YhphQOzniBEDnFn5AMvIYEw+8Fa2cDAgWKGUO5085fCV/7dRH vRyfKdosaQvafb9VLhqLrN3f6cZNHMkaitQXoZghkYr/aYnuxUNJM9pJb3KFS3pAiV jxEtMTy6L3DNXfxaPUEMEurBjCh1tAILlF8tC/t8KoOQf/rN5JtV3gdh+H0XiSPKz3 xnQirwSq8uIva09ruMp0DaEs39qJveJIw9Zd15z1KxdKYAX329HBn6ffLUEw3e3ni8 iEN3tC8usWxlg== X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Original-Received: from strobelfssd ([94.134.196.103]) by mail.gmx.net (mrgmx105 [212.227.17.168]) with ESMTPSA (Nemesis) id 1MTiPl-1pent73jmn-00U34B for ; Wed, 31 May 2023 11:12:32 +0200 X-Provags-ID: V03:K1:H88JzpksvwQ63p+jbwN9AFthh2j7OUGIGIZLl3N4y3WcLmA8kVb 3wCIbpSo6D9LWCyGIP6bXcaKB5siRMr71YhZS0E8GX+C6DSX5tC2dPtooLlNyIGRnxsVc2w oeLxyo9tvOrv0mzGiWbBCLbbEzZCmIFELBF6xVYzWjRKAy/0bUrBry/5IkfuhLUKP48KCdl Or/UpLA9b/NMiV5gWt7Yg== UI-OutboundReport: notjunk:1;M01:P0:tQ8AhEjYoDM=;OyfMACFi2iMkdc7RxksAMCswpI/ 4CPMLOla70sH/7NLGYKUD9uQunFCMjRSH5GHbqF9Lx+LmgtqPFAHwrlM5VQzz5s8/swk2IY6O oddXdLtoGHQGP4zxN8LH5hbOd3afUY6J/1VT4KDybj/YM0CoZbB7oYqtH82xPIFEKpY2AsC/j n9s5IueKBsYXYuUsFHSS+CSnMXe1bgO5BTbffcOBdfvdoouGO2AX61HquDugucM3y+cX2Ix+V l/B0BmVWgV2nCAK2+mBbup5nR2Egu6DIAgxyTWu2RiK7omAvZ/HzBjQv4pwk19GhEMFaTySAc 89J1DKN2q5p8U5UceKVHwkhbOW/ZkX4HOH4h8B+E1g50UOrbEBCUlbsznZb1sLkNkBE2NmXOy wt0Y3oJQYRnOPzbANnYjjezCwdpoYBXcs31sG7JSHGyF/ZWUQPe6+mfKE/lyV3GWcLGF4zGkl SW5RoVKG6mLTJn1bnTSzgx3PMw+ml4Eyir6A+c6WfnRwhvTsOLMdZr4suq3wB9qJFA7FgXmkc FEYTdzuZ55pXZb2tdIkvQy1nLPScgePSPXOgZFAOP2egyYlFqt5QgsoWMVO/MNBrzl8l0S5od Fi4xlOvos7t/kBFxgIow6h5iLeyj8t0NJ4M97l2SGIOvpxjrSJbtd35b+kd1eWj2fl8rDpDkx G1ZyyrMh6tqxiUmVjFMbWzaKNTKOQf6fTa/JuVABVxviy/pIth+6EWCqgzZGJOE8rmb+ne7mG OodTXzuBUUdnUTo+TibYv1DYoS9b10Kve18rLRC8Yd2y9Hsgeidk0xkI+qg536NkFvZ7NNyQ Received-SPF: pass client-ip=212.227.17.21; envelope-from=stephen.berman@gmx.net; helo=mout.gmx.net X-Spam_score_int: -27 X-Spam_score: -2.8 X-Spam_bar: -- X-Spam_report: (-2.8 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_LOW=-0.7, RCVD_IN_MSPIKE_H4=0.001, RCVD_IN_MSPIKE_WL=0.001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:262649 Archived-At: --=-=-= Content-Type: text/plain I have encountered several bugs in todo-mode when creating and editing todo items. I have fixes for them and since I'm the todo-mode maintainer I intend to push them to the Savannah repo when I get a bug number and clearance for which branch to push to. The bugs are long-standing, at least since Emacs 28 and probably earlier. The fixes touch no code outside of todo-mode.el and seem low-risk; in my testing they work as expected. I've attached a diff against emacs-29 below (the todo-mode.el files in current emacs-29 and master are identical). One of the bugs is that, when editing an item's date-time header string, which uses replace-match, the match data can get clobbered, e.g. by using dabbrev-expand while editing. (In bug#42976 I had fixed the same bug just for editing a done item comment, but at the time didn't notice that it can also happen when editing the item header string.) The other bugs all have to do with the fact that you can switch from the buffer in which an item is entered or edited (mainly the minibuffer, but for editing also a special indirect buffer of the todo-mode buffer) to the todo-mode buffer and there, move point to another item (with `n' or `p') or to another todo category in the todo file (with `f' or `b'). This possibility is useful in order, for example, to copy text from another item to use in the item you are creating or editing (you could, of course, do that before invoking the item insertion or editing command, then there's no problem). But when you move point in this way and then switch back to the editing buffer without moving point back to where it was when you invoked the item insertion or editing command, this can cause problems ranging from relatively harmless though annoying, such as misplacement of the inserted or edited item (you can always relocate the item later in todo-mode, when you notice the misplacement), to serious, such as unintentionally replacing data and even corruption of the todo-mode file format. The latter can happen in three ways: (1) Type `ee' on an item in todo-mode to edit it in the minibuffer and before typing RET to complete the edit, switch back to the todo-mode buffer, type `f' to display the next category in the todo file, then switch back to the minibuffer and complete the edit. The edited item does not replace the item on which `ee' was invoked but instead is entered into the category moved to as the first item, replacing the item that was there before. (2) In a todo category that has done items, type `ih' ("insert here") to insert a new item into the todo buffer on the line at point, and before completing the item (by typing RET in the minibuffer), switch to the todo-mode buffer, display the done items (`v'), move point (e.g. with `n') to one of the done items, then switch back to the minibuffer and complete with RET. The item will be inserted in the done items section but it doesn't have the form of a done item, so you can't repair the mistake using todo-mode commands, and also the calculated category counts of todo and done items now conflict with the resulting distribution of the items in the category. (3) The todo-mode buffer is read-only most of the time and is supposed to be changed only by using todo-mode commands, which temporarily make it writeable. However, the item editing commands `ee' (for item text) and `ec' (for done item comments) currently already make the todo-mode buffer writeable when the minibuffer is being used for editing, and if you then switch to the todo-mode buffer, you can corrupt it by inserting newlines or yanking arbitrary text (but self-inserting keys remain disabled in todo-mode). In GNU Emacs 29.0.91 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.24.37, cairo version 1.17.6) of 2023-05-27 built on strobelfssd Repository revision: 5e7c826bfa5cb7459f5b162b498af1c57c4578e6 Repository branch: emacs-29 Windowing system distributor 'The X.Org Foundation', version 11.0.12101008 System Description: Linux From Scratch r11.3-100-systemd Configured using: 'configure -C --with-xwidgets 'CFLAGS=-Og -g3'' Configured features: ACL CAIRO DBUS FREETYPE GIF GLIB GMP GNUTLS GPM GSETTINGS HARFBUZZ JPEG JSON LCMS2 LIBSYSTEMD LIBXML2 MODULES NOTIFY INOTIFY PDUMPER PNG RSVG SECCOMP SOUND SQLITE3 THREADS TIFF TOOLKIT_SCROLL_BARS WEBP X11 XDBE XIM XINPUT2 XPM XWIDGETS GTK3 ZLIB --=-=-= Content-Type: text/plain Content-Disposition: inline Content-Description: commit message 2023-05-31 Stephen Berman Fix several todo-mode.el item editing bugs (bug#) * 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. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment Content-Description: todo-mode.el patch Content-Transfer-Encoding: quoted-printable diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index 671210f3ee8..35cac5d7310 100644 =2D-- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -1985,7 +1985,13 @@ todo-insert-item--basic (setq done-only t) (todo-toggle-view-done-only)) (if here - (todo-insert-with-overlays new-item) + (progn + ;; Ensure item is inserted where command was invoked. + (unless (=3D (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)) (setq item-added t)) ;; If user cancels before setting priority, restore @@ -2119,6 +2125,9 @@ todo-edit-item ((or marked (todo-item-string)) (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) "Function providing the text editing facilities of `todo-edit-item'." (let ((full-item (todo-item-string))) @@ -2127,6 +2136,7 @@ todo-edit-item--text ;; 1+ signals an error, so just make this a noop. (when full-item (let* ((opoint (point)) + (ocat (todo-current-category)) (start (todo-item-start)) (end (save-excursion (todo-item-end))) (item-beg (progn @@ -2151,8 +2161,7 @@ todo-edit-item--text (concat " \\[" (regexp-quote todo-comment-string) ": \\([^]]+\\)\\]") end t))) - (prompt (if comment "Edit comment: " "Enter a comment: ")) - (buffer-read-only nil)) + (prompt (if comment "Edit comment: " "Enter a comment: "))) ;; When there are marked items, user can invoke todo-edit-item ;; even if point is not on an item, but text editing only ;; applies to the item at point. @@ -2170,22 +2179,43 @@ todo-edit-item--text end t) (if comment-delete (when (todo-y-or-n-p "Delete comment? ") - (delete-region (match-beginning 0) (match-end 0))) - (replace-match (save-match-data - (read-string prompt - (cons (match-string 1) = 1))) - nil nil nil 1)) + (let ((buffer-read-only nil)) + (delete-region (match-beginning 0) (match-end 0)))) + (let ((buffer-read-only nil)) + (replace-match (save-match-data + (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 (=3D (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 (user-error "There is no comment to delete") - (insert " [" todo-comment-string ": " - (prog1 (read-string prompt) - ;; If user moved point during editing, - ;; make sure it moves back. - (goto-char opoint) - (todo-item-end)) - "]"))))) + (let ((buffer-read-only nil)) + (insert " [" todo-comment-string ": " + (prog1 (let ((buffer-read-only t)) + (read-string prompt)) + ;; If user moved point while inserting a + ;; comment, restore it and ensure done items + ;; section is displayed. + (unless (=3D (point) opoint) + (todo-category-number ocat) + (let ((todo-show-with-done t)) + (todo-category-select) + (goto-char opoint))) + (todo-item-end)) + "]")))))) (multiline (let ((buf todo-edit-buffer)) + (setq todo-edit-item--cat ocat) + (setq todo-edit-item--pos opoint) (set-window-buffer (selected-window) (set-buffer (make-indirect-buffer (buffer-name) buf))) @@ -2208,10 +2238,14 @@ todo-edit-item--text ;; Ensure lines following hard newlines are indented. (setq new (replace-regexp-in-string "\\(\n\\)[^[:blank:]]" "\n\t" new nil nil 1)) - ;; If user moved point during editing, make sure it moves back. - (goto-char opoint) - (todo-remove-item) - (todo-insert-with-overlays new) + ;; If user moved point while editing item, restore it. + (unless (=3D (point) opoint) + (todo-category-number ocat) + (todo-category-select) + (goto-char opoint)) + (let ((buffer-read-only nil)) + (todo-remove-item) + (todo-insert-with-overlays new)) (move-to-column item-beg))))))))) (defun todo-edit-quit () @@ -2243,6 +2277,9 @@ todo-edit-quit (kill-buffer) (unless (eq (current-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))) ;; We got here via `F e'. (when (todo-check-format) @@ -2315,117 +2352,118 @@ todo-edit-item--header ;; 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=3D 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=3D omonth "*") (=3D mm 13)) - (user-error "Cannot increment *")) - (t - (let* ((mmo mm) - ;; Change by 12 or more months? - (bigincp (>=3D (abs inc) 12)) - ;; Month number is in range 1..12. - (mminc (+ mm (% inc 12))) - (mm (% (+ mminc 12) 12)) - ;; 12n mod 12 =3D 0, so 0 is December. - (mm (if (=3D 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 (=3D 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 (=3D 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=3D oday "*") - (user-error "Cannot increment *")) - ((or (string=3D omonth "*") (string=3D 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=3D 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))))))))) + (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=3D 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=3D omonth "*") (=3D mm 13)) + (user-error "Cannot increment *")) + (t + (let* ((mmo mm) + ;; Change by 12 or more months? + (bigincp (>=3D (abs inc) 12)) + ;; Month number is in range 1..12. + (mminc (+ mm (% inc 12))) + (mm (% (+ mminc 12) 12)) + ;; 12n mod 12 =3D 0, so 0 is December. + (mm (if (=3D 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 (=3D 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 (=3D 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=3D oday "*") + (user-error "Cannot increment *")) + ((or (string=3D omonth "*") (string=3D 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=3D 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. --=-=-=--