all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
* bug#67331: 30.0.50; New Todo mode feature: changing item date style
@ 2023-11-21 15:32 Stephen Berman
  2023-11-23  8:06 ` Eli Zaretskii
  0 siblings, 1 reply; 3+ messages in thread
From: Stephen Berman @ 2023-11-21 15:32 UTC (permalink / raw)
  To: 67331

[-- Attachment #1: Type: text/plain, Size: 12874 bytes --]

This post is a followup to bug#66395, where I posted (and subsequently
installed) a patch to support the ISO date style in Todo mode item
headers.  As I pointed out in that bug thread, despite supporting
different date styles, Todo mode does not support interactively and
automatically changing between different date styles.  I have attempted
to add this functionality to Todo mode, and the attached patch contains
my work-in-progress implementation.  I'm still testing these changes, so
even if they are deemed acceptable I'm not yet ready to install them,
but they raise some questions and how I proceed will be influenced and
perhaps decided by the answers to these questions.

The rest of this post is directed mainly to the Emacs maintainers and I
apologize to them for its length, but unless they want to leave it
entirely up to me how to proceed with these changes, I think they need
to know in at least some detail what the issues are.  As an aid to
contextualizing these issues without having to carefully examine the
code changes, here is a ChangeLog-style summary of the changes:

   New Todo mode feature: changing item date format

   This can be done both interactively by invoking a function to set
   the new date style, and also automatically when switching from a
   todo-mode buffer that uses a given date style to another one that
   uses a different one.

   To facilitate this functionality the internal todo-mode metadata
   sexp has been augmented to include the current setting of the date
   style in addition to the existing list of todo categories and
   their items counts.  When a todo file containing the previous
   categories-only sexp is visited, the sexp is automatically changed
   to the new file metadata format.

   * lisp/calendar/calendar.el
   (calendar-after-set-date-style-function): New variable.
   (calendar-set-date-style): Call it when non-nil.

   * lisp/calendar/todo-mode.el (todo--file-metadata): New variable.
   (todo--date-pattern-groups): This is now a function instead of a
   defconst.  Use it...
   (todo--make-date-pattern): ...in this new function.  Use it to get
   the value of...
   (todo-date-pattern): ...this variable, which is now a defvar
   instead of a defconst.
   (todo--set-file-metadata, todo--get-file-metadata)
   (todo--update-file-metadata): New functions to set, access and
   update todo file metadata.
   (todo-show): Use `todo--get-file-metadata' to test for a new todo file.
   (todo-add-file): Improve doc string.  Insert file metadata sexp.
   (todo-add-category, todo-rename-category): Update file metadata by
   calling `todo--update-file-metadata'.
   (todo-move-category): Insert file metadata sexp if moved to file
   is new.  Simplify updating todo categories metadata in moved to file.
   (todo-edit-item--header): Use function `todo--date-pattern-groups'.
   Improve a comment.
   (todo-set-categories, todo-update-categories-sexp)
   (todo-check-format): Adjust to new file metadata format.
   (todo--maybe-update-date-style, todo--change-date-header-form):
   New functions to determine whether to alter the format of todo
   item date headers, and if so, to automatically do it.  The latter
   function is added as the overriding value of the new variable
   `calendar-after-set-date-style-function' to enable interactively
   changing the date header format.
   (todo-category-completions): Adjust to new file metadata format
   and remove test for new todo file, since that is now done...
   (todo-read-category): ...here, using `todo--get-file-metadata'.
   (todo-key-bindings-t+a+f): Add binding for `calendar-set-date-style'
   to facilitate interactively changing the date header format.
   (todo-modes-set-3): Make `todo--file-metadata' buffer-local and
   evaluate it.  Call `todo--maybe-update-date-style' both directly
   and as a hook on `window-buffer-change-functions', to adjust item
   date headers if necessary.  The former is used when switching to
   another todo-mode buffer as a result of invoking a relevant
   todo-mode operation, the latter when switching from outside of
   todo-mode (e.g., when burying a todo-mode buffer makes another
   todo-mode buffer current).

Here are the main issues these changes raise that I think should be
resolved before proceeding:

- Although the use and effect of this feature is confined to
  todo-mode.el, it depends on a making a change to calendar.el, as you
  can see in the above summary and in the patch.  The reason, as I
  already noted in bug#66395, is that Todo mode date styles are
  specified by `calendar-date-display-form', which you can change by
  customizing `calendar-date-style' or by executing
  `calendar-set-date-style'.  To keep this connection I added a hook to
  calendar.el callable from the latter function, that can be used to
  trigger the date header changes in Todo mode (but it's not a hook in
  the usual sense of being intended for user customization; rather, it's
  intended for use by packages).  There is precedence for this in commit
  a8f4bb8361, where I similarly added a hook to diary-lib.el for the
  benefit of todo-mode.el.  In addition, since the hook has the value
  nil by default, there is no change to the default behavior of the
  Emacs Calendar (or Diary).  So, is this change to calendar.el
  acceptable?  (In fact, diary-lib.el could probably also use this
  change in calendar.el to implement date-style switching in the Emacs
  Diary.)

- My implementation of this feature crucially involves a change in the
  internal form of todo files.  Till now the first line of each todo
  file has contained a sexp listing the categories in the file (this
  line is hidden in todo-mode), but to allow switching date styles I
  have augmented this sexp to also contain a specification of the
  current date style used by the item headers in the file.  A number of
  existing todo-mode functions make use of this sexp, so they have also
  had to be adapted.  All these changes are strictly internal, so the
  Todo mode UI remains unchanged.  The implementation also includes
  automatically converting existing todo files to the augmented metadata
  format, so that users of Todo mode can continue using existing todo
  files, as well as the new functionality, without needing to be aware
  of the internal changes.  But once converted, the todo files will not
  be compatible with previous versions of todo-mode.el.  This would be a
  problem if someone wanted to use the same todo files on different
  systems, not all of which have an Emacs where todo-mode.el has these
  changes.

  Is this problem considered unacceptable?  If so, the easiest solution
  I can think of is to add a function that would detect if the feature
  is available and if not, automatically convert todo files with the new
  metadata format to the previous format, i.e., undoing the automatic
  change the current implementation makes.  I haven't implemented such
  an undoing function yet, because it wouldn't be needed if the problem
  is not considered unacceptable.  (This kind of issue came up when I
  announced my rewrite of the original version of todo-mode.el years ago
  on emacs-devel, and at that time it was decided against keeping the
  older format available; but that rewrite involved significant
  incompatible UI changes, whereas the present extension of UI
  functionality makes only internal incompatible changes.)

  Another possible solution, if the problem is not acceptable, is to
  make it possible to install both the new and a previous version of
  todo-mode.el in parallel.  AFAICS this would require making
  todo-mode.el an ELPA package.  This may be a worthwhile alternative
  regardless of the question of backwards compatibility, since
  todo-mode.el is by no means an indispensable part of Emacs.  (In fact,
  I thought about this alternative before my rewrite of todo-mode.el was
  added to Emacs, but for me keeping todo-mode.el in Emacs proper has
  been the path of least resistance.)

- A related issue concerns the scope of the date-style switching
  operation.  As implemented in the attached patch, date headers are
  changed only in the currently visited todo file, either interactively
  by invoking a command that changes the date style and then each item
  date header, or automatically when switching to a todo file whose
  metadata specifies a different date style from the current one.  No
  changes are made to non-visited todo files.  I did it this way because
  it struck me as wasteful to change files even if the change is unseen
  (and the date style and item headers could be repeatedly changed in a
  given file or selection of files, without visiting the majority of
  todo files), and in my testing, both interactive and automatic
  switching seemed practically instantaneous, even with my largest todo
  file with well over a thousand items.

  On the other hand, in the current implementation the automatic change
  of the metadata sexp to the new format is also only on demand, i.e.,
  on visiting a todo file.  But once that change is made, it is
  permanent, so that on revisiting the file it then already has the new
  format.  Because of this it might seem more efficient to convert all
  todo files once and for all.  I haven't done that for two reasons: one
  is that the change it practically imperceptible, so doing it on demand
  should cause no annoyance.  And secondly, if it is decided to enable
  reverting to the old format for use with older versions of
  todo-mode.el, it will of course then be necessary to change back to
  the new format again on revisiting a file whose format has been
  reverted with the new version of todo-mode.el, so if all files have
  been changed, that might make a perceptible and possibly annoying
  difference (though I haven't made any measurements).

  So is it acceptable to change the metadata format and the item header
  for each todo file on demand instead of for all todo files at once?

- Another thorny issue is how to deal with unit tests.  Currently, there
  are a number of tests for todo-mode.el using ERT.  Since they all
  require a todo file as input data and many make use of the file
  metadata (currently in the old format), at least these tests will
  require adjusting.  So should there be parallel tests for todo-mode
  with the new and with the previous metadata format?  Or should the
  older format be declared obsolete?  (However, AFAIK there is no formal
  obsoletion mechanism for data formats as opposed to functions and
  variables.)  I think the decision about this is contingent on the
  decision about allowing reverting the format for backwards
  compatibility.

- The Tode mode manual will of course need to be updated to document the
  new feature.  Currently, the manual does not document the internal
  structure of todo files, including the metadata sexp (it is only
  mentioned in passing in a couple of places).  If reverting to the
  older metadata format is made an option, this would seem to invite
  giving at least some details of the incompatible metadata formats, but
  I'm not sure it's necessary.

Finally, I want to point out an issue that I think is mainly orthogonal
to the new feature and the preceding considerations, but it helps
clarify the extent of the feature.  Currently, Todo mode supports item
date headers with either the American, European or ISO date style, but
all items can only be displayed with the same style, and that
restriction will persist if the changes discussed here are installed:
then you can switch date styles, but doing so changes all item headers
in a visited todo file.  In other words, there can be no mixing of date
styles within a todo file, or when switching between todo files.  This
restriction is justified by avoiding ambiguity if dates are displayed
simultaneously in the European and American styles with numbers for
months.  Admittedly, `calendar-date-display-form' uses month names by
default in these styles, which avoids ambiguity (and there's no
ambiguity between the ISO style and the other styles, unless years are
displayed with just the two least significant digits, which is common in
the American and European styles but AFAIK the ISO standard requires
four digits for years).  Hence, at least for such display forms, mixing
date display styles should be possible (though whether it's desirable is
questionable).  I haven't given serious thought to how to implement
that, nor to how it would interact with the proposed feature of
switching date styles without mixing, but it would likely require
changes to the implementation in the attached patch.

Steve Berman


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Todo mode feature patch --]
[-- Type: text/x-patch, Size: 34826 bytes --]

diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index 02167d84b3e..5d652c4e08b 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -992,6 +992,12 @@ calendar-month-header
   :type 'sexp
   :version "24.3")

+(defvar calendar-after-set-date-style-function nil
+  "Function called after changing calendar date style.
+By providing a suitable function, modes that use calendar date
+styles can ensure that any mode-specific adjustments required on
+changing the date style are automatically made.")
+
 (defun calendar-set-date-style (style)
   "Set the style of calendar and diary dates to STYLE (a symbol).
 The valid styles are described in the documentation of `calendar-date-style'."
@@ -1010,7 +1016,9 @@ calendar-set-date-style
         diary-date-forms
         (symbol-value (intern-soft (format "diary-%s-date-forms" style))))
   (calendar-redraw)
-  (calendar-update-mode-line))
+  (calendar-update-mode-line)
+  (when calendar-after-set-date-style-function
+    (funcall calendar-after-set-date-style-function)))

 (defcustom diary-show-holidays-flag t
   "Non-nil means include holidays in the diary display.
diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el
index 4f6a964eb4d..3a08e9587dd 100644
--- a/lisp/calendar/todo-mode.el
+++ b/lisp/calendar/todo-mode.el
@@ -110,6 +110,11 @@ todo-global-current-todo-file
 (defvar todo-current-todo-file nil
   "Variable holding the name of the currently active todo file.")

+(defvar todo--file-metadata nil
+  "Alist of metadata for the current todo file.
+This is sexp specifying the current todo item date header style
+and the list of the file's todo categories.")
+
 (defvar todo-categories nil
   "Alist of categories in the current todo file.
 The elements are cons cells whose car is a category name and
@@ -189,53 +194,62 @@ todo-month-abbrev-array
   "Array of abbreviated month names, in order.
 The final element is \"*\", indicating an unspecified month.")

-(defconst todo--date-pattern-groups
-  (pcase calendar-date-style
+(defun todo--date-pattern-groups (style)
+  "Return an alist for groups in `todo-date-pattern' based on STYLE.
+The argument STYLE is one of the symbols `american', `european'
+or `iso', as used by `calendar-date-style'."
+  (pcase style
           ('american '((monthname . "6") (month . "7") (day . "8") (year . "9")))
           ('european '((day . "6") (monthname . "7") (month . "8") (year . "9")))
-          ('iso '((year . "6") (monthname . "7") (month . "8") (day . "9"))))
-  "Alist for grouping date components in `todo-date-pattern'.")
-
-(defconst todo-date-pattern
-  (let* ((dayname (diary-name-pattern calendar-day-name-array nil t))
-         (d (concat "\\(?" (alist-get 'day todo--date-pattern-groups)
+          ('iso '((year . "6") (monthname . "7") (month . "8") (day . "9")))))
+
+(defun todo--make-date-pattern (&optional style)
+  "Return a regular expression matching a todo item date header.
+With argument STYLE (see `todo--date-pattern-groups') the
+resulting expression matches the specific style, otherwise it
+matches the style specified by `calendar-date-display-form'."
+  (let* ((display-form (if style
+                           (symbol-value
+                            (intern-soft
+                             (format "calendar-%s-date-display-form" style)))
+                         calendar-date-display-form))
+         (groups (todo--date-pattern-groups (or style calendar-date-style)))
+         (dayname (diary-name-pattern calendar-day-name-array nil t))
+         (d (concat "\\(?" (alist-get 'day groups)
                     ":[0-9]+\\|\\*\\)"))
-         (mn (format (concat "\\(?" (alist-get 'monthname
-                                               todo--date-pattern-groups)
-                             ":%s\\)")
+         (mn (format (concat "\\(?" (alist-get 'monthname groups) ":%s\\)")
                      (diary-name-pattern todo-month-name-array
                                          todo-month-abbrev-array)))
-         (m (concat "\\(?" (alist-get 'month todo--date-pattern-groups)
-                    ":[0-9]+\\|\\*\\)"))
-         (y (concat "\\(?" (alist-get 'year todo--date-pattern-groups)
-                    ":[0-9]+\\|\\*\\)"))
+         (m (concat "\\(?" (alist-get 'month groups) ":[0-9]+\\|\\*\\)"))
+         (y (concat "\\(?" (alist-get 'year groups) ":[0-9]+\\|\\*\\)"))
          (dd "1111111")
          (mm "2222222")
          (yy "3333333")
-         (s (concat "\\(?4:\\(?5:" dayname "\\)\\|"
-	            (calendar-dlet
-                        ((dayname)
-		         (monthname mn)
-		         (year yy)
-		         (month mm)
-		         (day dd))
-                      (mapconcat #'eval calendar-date-display-form))
-	            "\\)")))
+         (pattern (concat "\\(?4:\\(?5:" dayname "\\)\\|"
+	                  (calendar-dlet
+                              ((dayname)
+		               (monthname mn)
+		               (year yy)
+		               (month mm)
+		               (day dd))
+                            (mapconcat #'eval display-form))
+	                  "\\)")))
     ;; The default value of calendar-iso-date-display-form calls
     ;; `string-to-number' on the values of `month' and `day', so we
     ;; gave them placeholder values above and now replace these with
     ;; the necessary regexps with appropriately numbered groups, because
     ;; `todo-edit-item--header' uses these groups.
-    (when (string-match dd s nil t)
-      (setq s (string-replace dd d s)))
-    (when (string-match mm s nil t)
-      (setq s (string-replace mm m s)))
-    (when (string-match yy s nil t)
-      (setq s (string-replace yy y s)))
-    s)
+    (when (string-match dd pattern nil t)
+      (setq pattern (string-replace dd d pattern)))
+    (when (string-match mm pattern nil t)
+      (setq pattern (string-replace mm m pattern)))
+    (when (string-match yy pattern nil t)
+      (setq pattern (string-replace yy y pattern)))
+    pattern))
+
+(defvar todo-date-pattern (todo--make-date-pattern)
   "Regular expression matching a todo item date header.
-The value of `calendar-date-display-form' determines the form of
-the date header.")
+The value is generated by `todo--make-date-pattern'.")

 ;; By itself this matches anything, because of the `?'; however, it's only
 ;; used in the context of `todo-date-pattern' (but Emacs Lisp lacks
@@ -684,7 +698,7 @@ todo-show
   (when todo-default-todo-file
     (todo-check-file (todo-absolute-file-name todo-default-todo-file)))
   (catch 'shown
-    ;; Before initializing the first todo first, check if there is a
+    ;; Before initializing the first todo file, check if there is a
     ;; legacy todo file and if so, offer to convert to the current
     ;; format and make it the first new todo file.
     (unless todo-default-todo-file
@@ -781,11 +795,11 @@ todo-show
 	  (when (assoc cat todo-categories)
 	    (setq todo-category-number (todo-category-number cat)))
 	  ;; If this is a new todo file, add its first category.
-	  (when (zerop (buffer-size))
+	  (unless (todo--get-file-metadata 'categories)
             ;; Don't confuse an erased buffer with a fresh buffer for
             ;; adding a new todo file -- it might have been erased by
-            ;; mistake or due to a bug (e.g. Bug#20832).
-            (when (buffer-modified-p)
+            ;; mistake or due to a bug (e.g. bug#20832).
+            (when (and (zerop (buffer-size)) (buffer-modified-p))
               (error "Buffer is empty but modified, please report a bug"))
 	    (let (cat-added)
 	      (unwind-protect
@@ -799,10 +813,13 @@ todo-show
 		    ;; signal an error if we tried to visit it later,
 		    ;; since doing that looks for category boundaries.
 		    (save-buffer 0)
-		  ;; If user cancels before adding the category, clean up
-		  ;; and exit, so we have a fresh slate the next time.
-		  (delete-file file)
-		  ;; (setq todo-files (funcall todo-files-function))
+		  ;; If user cancels before adding the category, clean
+		  ;; up and exit, so we have a fresh slate the next
+		  ;; time.  FIXME: this can be dangerous while
+		  ;; developing, so for now require confirmation.
+		  (if (yes-or-no-p (format "Delete file %s" file))
+                      (delete-file file)
+                    (message "File %s not deleted, check it" file))
 		  (setq todo-files (delete file todo-files))
 		  (when first-file
 		    (setq todo-default-todo-file nil
@@ -1119,7 +1136,7 @@ todo-toggle-item-header
 ;; -----------------------------------------------------------------------------

 (defun todo-add-file ()
-  "Name and initialize a new todo file.
+  "Name, initialize and save a new todo file.
 Interactively, prompt for a category and display it, and if
 option `todo-add-item-if-new-category' is non-nil (the default),
 prompt for the first item.
@@ -1127,12 +1144,16 @@ todo-add-file
   (interactive)
   (let* ((prompt (concat "Enter name of new todo file "
 			 "(TAB or SPC to see current names): "))
-	 (file (todo-read-file-name prompt)))
+	 (file (todo-read-file-name prompt))
+         (metadata `((date-style . ,calendar-date-style)
+                     (categories . nil))))
     ;; Don't accept the name of an existing todo file.
     (setq file (todo-absolute-file-name
 		(todo-validate-name (todo-short-file-name file) 'file)))
     (with-current-buffer (get-buffer-create file)
       (erase-buffer)
+      (prin1 metadata (current-buffer))
+      (terpri (current-buffer))
       (write-region (point-min) (point-max) file nil 'nomessage nil t)
       (kill-buffer file))
     (setq todo-files (funcall todo-files-function))
@@ -1141,7 +1162,7 @@ todo-add-file
 	(progn
 	  (set-window-buffer (selected-window)
 			     (set-buffer (find-file-noselect file)))
-	  ;; Since buffer is not yet in todo-mode, we need to
+          ;; Since buffer is not yet in todo-mode, we need to
 	  ;; explicitly make todo-current-todo-file buffer local.
           (setq-local todo-current-todo-file file)
 	  (todo-show))
@@ -1340,6 +1361,7 @@ todo-add-category
 	(let ((inhibit-read-only t))
 	  (insert todo-category-beg cat "\n\n" todo-category-done "\n")))
       (todo-update-categories-sexp)
+      (todo--update-file-metadata)
       ;; If invoked by user, display the newly added category, if
       ;; called programmatically return the category number to the
       ;; caller.
@@ -1378,7 +1400,8 @@ todo-rename-category
 		(re-search-forward (concat (regexp-quote todo-category-beg)
 					   "\\(" (regexp-quote cat) "\\)\n")
 				   nil t)
-		(replace-match new t t nil 1)))))))
+		(replace-match new t t nil 1)
+                (todo--update-file-metadata)))))))
     (force-mode-line-update))
   (save-excursion (todo-category-select)))

@@ -1464,13 +1487,17 @@ todo-move-category
 	   (buffers (append (list ofile)
 			    (unless (zerop (todo-get-count 'archived cat))
 			      (list archive))))
-	   new)
+	   (metadata `((date-style . ,calendar-date-style)
+                       (categories . nil)))
+           new)
       (while (equal nfile (file-truename ofile))
 	(setq nfile (todo-read-file-name
 		     "Choose a file distinct from this file: ")))
       (unless (member nfile todo-files)
 	(with-current-buffer (get-buffer-create nfile)
 	  (erase-buffer)
+          (prin1 metadata (current-buffer))
+          (terpri (current-buffer))
 	  (write-region (point-min) (point-max) nfile nil 'nomessage nil t)
 	  (kill-buffer nfile))
 	(setq todo-files (funcall todo-files-function))
@@ -1542,15 +1569,7 @@ todo-move-category
 		  (replace-match new nil nil nil 1))
                 (setq todo-categories
                       (append todo-categories (list (cons (or new cat) counts))))
-                (goto-char (point-min))
-                (if (looking-at "((\"")
-                    ;; Delete existing sexp.
-                    (delete-region (line-beginning-position) (line-end-position))
-                  ;; Otherwise, file is new, so make space for categories sexp.
-                  (insert "\n")
-                  (goto-char (point-min)))
-                ;; Insert (new or updated) sexp.
-                (prin1 todo-categories (current-buffer)))
+                (todo-update-categories-sexp))
 	      ;; If archive was just created, save it to avoid "File
 	      ;; <xyz> no longer exists!" message on invoking
 	      ;; `todo-view-archived-items'.
@@ -2381,19 +2400,16 @@ todo-edit-item--header
 				     "\\)\\(?2: " diary-time-regexp "\\)?"
 				     (regexp-quote todo-nondiary-end) "?")
 			     (line-end-position) t)
-	  (let* ((otime (match-string-no-properties 2))
+	  (let* ((groups (todo--date-pattern-groups calendar-date-style))
+                 (otime (match-string-no-properties 2))
 		 (odayname (match-string-no-properties 5))
-                 (mngroup (string-to-number
-                           (alist-get 'monthname todo--date-pattern-groups)))
+                 (mngroup (string-to-number (alist-get 'monthname groups)))
 		 (omonthname (match-string-no-properties mngroup))
-                 (mgroup (string-to-number
-                          (alist-get 'month todo--date-pattern-groups)))
+                 (mgroup (string-to-number (alist-get 'month groups)))
 		 (omonth (match-string-no-properties mgroup))
-                 (dgroup (string-to-number
-                          (alist-get 'day todo--date-pattern-groups)))
+                 (dgroup (string-to-number (alist-get 'day groups)))
 		 (oday (match-string-no-properties dgroup))
-                 (ygroup (string-to-number
-                          (alist-get 'year todo--date-pattern-groups)))
+                 (ygroup (string-to-number (alist-get 'year groups)))
 		 (oyear (match-string-no-properties ygroup))
 		 (tmn-array todo-month-name-array)
 		 (mlist (append tmn-array nil))
@@ -2536,7 +2552,7 @@ todo-edit-item--header
 				(number-to-string (nth 1 date))))))))))
 	    (unless odayname
 	      ;; If year, month or day date string components were
-	      ;; changed, rebuild the date string.
+	      ;; changed, rebuild the date string using new values.
 	      (when (memq what '(year month day))
 		(setq ndate
                       (calendar-dlet
@@ -4813,6 +4829,7 @@ todo-convert-legacy-date-time
     (insert (mapconcat #'eval calendar-date-display-form)
 	    (when time (concat " " time)))))

+;; FIXME: now convert to file metadata format?
 (defun todo-convert-legacy-files ()
   "Convert legacy todo files to the current Todo mode format.
 The old-style files named by the variables `todo-file-do' and
@@ -5124,6 +5141,81 @@ todo-category-select
 	(require 'hl-line)
 	(hl-line-mode 1)))))

+(defun todo--set-file-metadata ()
+  "Return the sexp assigned to `todo--file-metadata'.
+This is the sexp comprising the first line of a todo file (hidden
+in todo-mode).  If that sexp is still in the superseded
+categories-only format, first convert it to the metadata format."
+  (save-excursion
+    (save-restriction
+      (widen)
+      (goto-char (point-min))
+      (let (converted metadata)
+        (if (looking-at "((\"")
+            ;; Convert old categories sexp to new metadata sexp.
+            (let ((cats (read (buffer-substring-no-properties
+                                (line-beginning-position)
+                                (line-end-position))))
+                   (style (progn
+                            (forward-line)
+                            (while (looking-at (concat "\\(" todo-category-beg
+                                                       "\\|" todo-category-done
+                                                       "\\|^$\\)"))
+                              (forward-line))
+                            (re-search-forward todo-date-string-start nil t)
+                            (when (looking-at todo-done-string)
+                              (goto-char (match-end 0)))
+                            (cond
+                             ((looking-at (todo--make-date-pattern 'american))
+                              'american)
+                             ((looking-at (todo--make-date-pattern 'european))
+                              'european)
+                             ((looking-at (todo--make-date-pattern 'iso))
+                              'iso))))
+                   (inhibit-read-only t))
+              (setq metadata `((date-style . ,style) (categories . (,cats))))
+              (goto-char (point-min))
+              (delete-region (line-beginning-position) (line-end-position))
+              (prin1 metadata (current-buffer))
+              (setq converted t))
+          (setq metadata
+                (if (looking-at "((date-style")
+                    (read (buffer-substring-no-properties
+                           (line-beginning-position)
+                           (line-end-position)))
+                  (error "Invalid or missing file metadata sexp"))))
+        (when converted
+          (save-buffer))
+        metadata))))
+
+(defun todo--get-file-metadata (type)
+  "Return the todo file metadata value specified by TYPE.
+TYPE is one of the symbols `date-style' or `categories'."
+  (pcase type
+    ('date-style (alist-get 'date-style todo--file-metadata))
+    ('categories (car (alist-get 'categories todo--file-metadata)))))
+
+(defun todo--update-file-metadata ()
+  "Return the up-to-date value of `todo--file-metadata'.
+This function also updates the file metadata sexp if necessary."
+  (let ((inhibit-read-only t)
+        (print-length nil)
+        (print-level nil))
+    (unless (and (equal (todo--get-file-metadata 'date-style)
+                        calendar-date-style)
+                 (equal (todo--get-file-metadata 'categories)
+                        todo-categories))
+      (save-excursion
+        (save-restriction
+          (widen)
+          (goto-char (point-min))
+          (delete-region (line-beginning-position) (line-end-position))
+          (prin1 `((date-style . ,calendar-date-style)
+                   (categories . (,todo-categories)))
+                 (current-buffer))
+          (when (eobp) (terpri (current-buffer)))))))
+  (setq todo--file-metadata (todo--set-file-metadata)))
+
 (defun todo-get-count (type &optional category)
   "Return count of TYPE items in CATEGORY.
 If CATEGORY is nil, default to the current category."
@@ -5148,34 +5240,38 @@ todo-update-count

 (defun todo-set-categories ()
   "Set `todo-categories' from the sexp at the top of the file."
-  ;; New archive files created by `todo-move-category' are empty, which would
-  ;; make the sexp test fail and raise an error, so in this case we skip it.
-  (unless (zerop (buffer-size))
-    (save-excursion
-      (save-restriction
-	(widen)
-	(goto-char (point-min))
-	(setq todo-categories
-	      (if (looking-at "((\"")
-		  (read (buffer-substring-no-properties
-			 (line-beginning-position)
-			 (line-end-position)))
-		(error "Invalid or missing todo-categories sexp")))))))
+  (save-excursion
+    (save-restriction
+      (widen)
+      (goto-char (point-min))
+      ;; A new todo file created by `todo-show' or an archive file
+      ;; created by `todo-move-category' has no categories sexp when
+      ;; this function is called, so we can't set todo-categories yet.
+      (when (todo--get-file-metadata 'categories)
+        (setq todo-categories
+              (if (re-search-forward "^((date.+) (categories \\(?1:((.+))\\)))$"
+                                     (line-end-position) t)
+                  (read (buffer-substring-no-properties
+                         (match-beginning 1) (match-end 1)))
+                (error "Invalid or missing todo-categories sexp")))))))

 (defun todo-update-categories-sexp ()
   "Update the `todo-categories' sexp at the top of the file."
   (let ((inhibit-read-only t)
 	(print-length nil)
         (print-level nil))
-    (save-excursion
-      (save-restriction
-	(widen)
-	(goto-char (point-min))
-	(if (looking-at (concat "^" (regexp-quote todo-category-beg)))
-	    (progn (newline) (goto-char (point-min)) ; Make space for sexp.
-		   (setq todo-categories (todo-make-categories-list t)))
-	  (delete-region (line-beginning-position) (line-end-position)))
-	(prin1 todo-categories (current-buffer))))))
+    (unless (equal (todo--get-file-metadata 'categories) todo-categories)
+      (save-excursion
+        (save-restriction
+          (widen)
+          (goto-char (point-min))
+          (re-search-forward "^((date.+) (categories" (line-end-position) t)
+          (if (looking-at " \\(?1:((.+))\\)))$")
+              (progn
+                (delete-region (match-beginning 1) (match-end 1))
+                (forward-char))
+            (insert " "))
+          (prin1 todo-categories (current-buffer)))))))

 (defun todo-make-categories-list (&optional force)
   "Return an alist of todo categories and their item counts.
@@ -5278,8 +5374,12 @@ todo-check-format
       (let* ((print-length nil)
              (print-level nil)
 	     (cats (prin1-to-string todo-categories))
-	     (ssexp (buffer-substring-no-properties (line-beginning-position)
-						    (line-end-position)))
+	     (ssexp (progn
+                      (re-search-forward
+                       "^((date.+) (categories \\(?1:((.+))\\)))$"
+                       (line-end-position) t)
+		      (buffer-substring-no-properties
+		       (match-beginning 1) (match-end 1))))
 	     (sexp (read ssexp)))
 	;; Check the first line for `todo-categories' sexp.
 	(dolist (c sexp)
@@ -5683,6 +5783,125 @@ todo-prefix-overlays
 					     prefix))))
 	(forward-line)))))

+(defun todo--maybe-update-date-style (&optional w)
+  "Check if item date headers must be changed and if so, do it.
+The optional argument W is the window of the current buffer,
+which is required by the hook `window-buffer-change-functions',
+to which this function is added by todo-mode to automatically
+alter the date headers (if necessary) on switching to a todo-mode
+buffer from outside of todo-mode.  In addition, todo-mode calls
+this function directly to alter the date headers (if necessary)
+when switching to a todo-mode buffer as a result of a todo-mode
+operation."
+  (let ((buf (or (and w (window-buffer w))
+                 (current-buffer)))
+        (style (todo--get-file-metadata 'date-style)))
+    (with-current-buffer buf
+      (when (and (memq major-mode '(todo-mode todo-archive-mode
+                                              todo-filtered-items-mode))
+                 (not (eq style calendar-date-style)))
+        (todo--change-date-header-form style)))))
+
+;; FIXME: archived items, saved virtual categories?
+(defun todo--change-date-header-form (&optional style)
+  "Alter date style of item date headers in the current todo file.
+Called without an argument, the new style is the current value of
+`calendar-date-style'.  With non-nil STYLE, use STYLE instead of
+the value of `calendar-date-style'.  This is for automatically
+\(i.e., non-interactively) changing a todo file's date headers
+after having changed the date header style."
+  ;; Since this function can be called outside of todo-mode (via
+  ;; `calendar-set-date-style'), make sure it's executed only when the
+  ;; current buffer is visiting a todo or archive file.
+  (when (member (buffer-file-name) (append todo-files todo-archives))
+    (save-excursion
+      (save-restriction
+        (let ((inhibit-read-only t)
+              (ostyle (todo--get-file-metadata 'date-style))
+              (pattern (if style
+                           (todo--make-date-pattern style)
+                         todo-date-pattern))
+              (done-item nil))
+          (widen)
+          (goto-char (point-min))
+          (while (if done-item
+                     (progn
+                       (setq done-item nil)
+                       ;; The original item date string following the done date.
+                       (looking-at (concat "\\(?1:" pattern "\\)")))
+                   (re-search-forward (concat "\\(" todo-date-string-start "\\|"
+                                              todo-done-string-start "\\)\\(?1:"
+                                              pattern "\\)")
+                                      nil t))
+            (let ((dayname (match-string-no-properties 5)))
+              (unless dayname
+                (let* ((groups (todo--date-pattern-groups
+                                (or ostyle style calendar-date-style)))
+                       ;; (time (match-string-no-properties 2))
+                       (mngroup (string-to-number (alist-get 'monthname groups)))
+                       (monthname (match-string-no-properties mngroup))
+                       (mgroup (string-to-number (alist-get 'month groups)))
+                       (month (if monthname
+                                  (number-to-string
+                                   (1+ (or (seq-position todo-month-abbrev-array
+                                                         monthname)
+                                           ;; Month name may be unabbreviated.
+                                           (seq-position todo-month-name-array
+                                                         monthname))))
+                                (match-string-no-properties mgroup)))
+                       (dgroup (string-to-number (alist-get 'day groups)))
+                       (day (match-string-no-properties dgroup))
+                       (ygroup (string-to-number (alist-get 'year groups)))
+                       (year (match-string-no-properties ygroup))
+                       (nh (calendar-dlet
+                               ((year year)
+                                ;; Prevent `calendar-iso-date-display-form'
+                                ;; from showing "13" as a month.
+                                (month (if (equal month "13") "*" month))
+                                (monthname (or monthname
+                                               (aref todo-month-abbrev-array
+                                                     (1- (string-to-number
+                                                          (if (equal month "*")
+                                                              "13"
+                                                            month))))))
+                                ;; When converting from ISO to
+                                ;; American or European, trucate
+                                ;; any leading zero.
+                                (day (let ((d (car (read-from-string day))))
+                                       (if (numberp d) ; not "*"
+                                           (number-to-string d)
+                                         (symbol-name d))))
+                                (dayname dayname))
+                             (mapconcat #'eval calendar-date-display-form)))
+                       ;; The value of `calendar-iso-date-display-form'
+                       ;; by default turns "*" into "00", so undo that.
+                       (new-header (string-replace "00" "*" nh)))
+                  (replace-match new-header nil t nil 1))
+                ;; We also need to loop over the original item date
+                ;; string following the done date, so set a flag to
+                ;; control the loop condition.
+                (when (looking-at (concat "\\( " diary-time-regexp "\\)?\\] \\("
+                                          (regexp-quote todo-nondiary-start) "\\|"
+	                                  (regexp-quote diary-nonmarking-symbol)
+                                          "\\)?\\(?1:" pattern "\\)"))
+                  (goto-char (match-beginning 1))
+                  (setq done-item t))))))))
+    (unless style
+      ;; After interactively changing all date strings to use the new
+      ;; style, update the date pattern and item-start regexes to
+      ;; ensure navigation and editing succeed.  (Not needed when
+      ;; automatically changing date headers because then they have
+      ;; already been updated.)
+      (setq todo-date-pattern (todo--make-date-pattern))
+      (setq todo-item-start (concat "\\(" todo-date-string-start "\\|"
+                                    todo-done-string-start "\\)"
+                                    todo-date-pattern)))
+    ;; Make sure the metadata sexp and variable are up-to-date.
+    (todo--update-file-metadata)))
+
+(add-function :override calendar-after-set-date-style-function
+              #'todo--change-date-header-form)
+
 ;; -----------------------------------------------------------------------------
 ;;; Generating and applying item insertion and editing key sequences
 ;; -----------------------------------------------------------------------------
@@ -5945,40 +6164,33 @@ todo-category-completions
 		      (mapcar #'todo-absolute-file-name
 			      todo-category-completions-files))
 		    (list curfile)))
-	 listall listf)
-    ;; If file was just added, it has no category completions.
-    (unless (zerop (buffer-size (find-buffer-visiting curfile)))
-      (unless (member curfile todo-archives)
-	(cl-pushnew curfile files :test #'equal))
-      (dolist (f files listall)
-	(with-current-buffer (find-file-noselect f 'nowarn)
-	  (if archive
-	      (unless (derived-mode-p 'todo-archive-mode) (todo-archive-mode))
-	    (unless (derived-mode-p 'todo-mode) (todo-mode)))
-	  ;; Ensure category is properly displayed in case user
-	  ;; switches to file via a non-Todo mode command.  And if
-	  ;; done items in category are visible, keep them visible.
-	  (let ((done todo-show-with-done))
-	    (when (> (buffer-size) (- (point-max) (point-min)))
-	      (save-excursion
-		(goto-char (point-min))
-		(setq done (re-search-forward todo-done-string-start nil t))))
-	    (let ((todo-show-with-done done))
-	      (save-excursion (todo-category-select))))
-	  (save-excursion
-	    (save-restriction
-	      (widen)
-	      (goto-char (point-min))
-	      (setq listf (read (buffer-substring-no-properties
-				 (line-beginning-position)
-				 (line-end-position)))))))
-	(mapc (lambda (elt) (let* ((cat (car elt))
-				   (la-elt (assoc cat listall)))
-			      (if la-elt
-				  (setcdr la-elt (append (list (cdr la-elt))
-							 (list f)))
-				(push (cons cat f) listall))))
-	      listf)))))
+	 allcats)
+    (unless (member curfile todo-archives)
+      (cl-pushnew curfile files :test #'equal))
+    (dolist (f files allcats)
+      (with-current-buffer (find-file-noselect f 'nowarn)
+        (if archive
+            (unless (derived-mode-p 'todo-archive-mode) (todo-archive-mode))
+          (unless (derived-mode-p 'todo-mode) (todo-mode)))
+        ;; Ensure category is properly displayed in case user
+        ;; switches to file via a non-Todo mode command.  And if
+        ;; done items in category are visible, keep them visible.
+        (let ((done todo-show-with-done))
+          (when (> (buffer-size) (- (point-max) (point-min)))
+            (save-excursion
+              (goto-char (point-min))
+              (setq done (re-search-forward todo-done-string-start nil t))))
+          (let ((todo-show-with-done done))
+            (save-excursion (todo-category-select))))
+        (let* ((todo--file-metadata (todo--set-file-metadata))
+               (cats (todo--get-file-metadata 'categories)))
+          (mapc (lambda (elt) (let* ((cat (car elt))
+                                     (la-elt (assoc cat allcats)))
+                                (if la-elt
+                                    (setcdr la-elt (append (list (cdr la-elt))
+                                                           (list f)))
+                                  (push (cons cat f) allcats))))
+                cats))))))

 (defun todo-read-file-name (prompt &optional archive mustmatch)
   "Choose and return the name of a todo file, prompting with PROMPT.
@@ -6040,7 +6252,11 @@ todo-read-category
 							       " todo")
 						 " file: ")
                                          archive t)))
-	   (completions (unless file0 (todo-category-completions archive)))
+	   (completions (when
+                            ;; If file was just added, it has no
+                            ;; categories, so no completions.
+                            (todo--get-file-metadata 'categories)
+                          (unless file0 (todo-category-completions archive))))
 	   (categories (cond (file0
 			      (with-current-buffer
 				  (find-file-noselect file0 'nowarn)
@@ -6165,6 +6381,10 @@ todo-validate-name
     name))

 ;; Adapted from calendar-read-date and calendar-date-string.
+;; Consequences (FIXME?): (i) Can't input a day number with a leading
+;; zero, due to the non-nil READ argument of read-from-minibuffer.
+;; (ii) We only call calendar-date-string with non-nil ABBREVIATE and
+;; NODAYNAME arguments.
 (defun todo-read-date (&optional arg mo yr)
   "Prompt for Gregorian date and return it in the current format.

@@ -6592,6 +6812,7 @@ todo-key-bindings-t
 (defvar todo-key-bindings-t+a+f
   '(("C*" todo-mark-category)
     ("Cu" todo-unmark-category)
+    ("Fd" calendar-set-date-style)
     ("Fh" todo-toggle-item-header)
     ("h"  todo-toggle-item-header)
     ("Fk" todo-delete-file)
@@ -6831,7 +7052,15 @@ todo-modes-set-2

 (defun todo-modes-set-3 ()
   "Make some settings that apply to multiple Todo modes."
+  (setq-local todo--file-metadata (todo--set-file-metadata))
   (setq-local todo-categories (todo-set-categories))
+  ;; FIXME: is there a better alternative?  Have to call directly when
+  ;; setting mode, but via w-b-c-f when a buffer with mode already set
+  ;; is assigned to a window (e.g. when burying one todo-mode buffer
+  ;; makes another one appear in the window).
+  (todo--maybe-update-date-style)
+  (add-hook 'window-buffer-change-functions
+            #'todo--maybe-update-date-style nil t)
   (setq-local todo-category-number 1)
   ;; (add-hook 'find-file-hook #'todo-display-as-todo-file nil t)
   )

^ permalink raw reply related	[flat|nested] 3+ messages in thread

end of thread, other threads:[~2023-11-23 17:40 UTC | newest]

Thread overview: 3+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2023-11-21 15:32 bug#67331: 30.0.50; New Todo mode feature: changing item date style Stephen Berman
2023-11-23  8:06 ` Eli Zaretskii
2023-11-23 17:40   ` Stephen Berman

Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.