bug#49995: 28.0.50; EBDB Anniversaries do not appear marked in calendar

[Eric Abrahamsen <eric@ericabrahamsen.net>]

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

Eric Abrahamsen <eric@ericabrahamsen.net> writes:

> Michael Heerdegen <michael_heerdegen@web.de> writes:
>
>> Eric Abrahamsen <eric@ericabrahamsen.net> writes:
>>
>>> Oof, EBDB's diary integration was "write once and back away slowly"
>>> code. I'm trying to understand diary-lib.el. So far as I can see, when
>>> you add diary entries to `diary-entry-list' [...]
>>
>> Suggestion: provide a new diary-sexp function, similar to
>> `diary-lunar-phases'.  Then marking would be handled by the diary.
>>
>> That function just has to return nil or a string (or a mark and a
>> string) depending on the dynamical variable DATE.  That's already the
>> whole diary related part.  People then have to add that function as sexp
>> entry to their diary if they want.
>
> Oh, huh: sort of inverting the prior approach. I find all this a little
> confusing, I've never spent any time with the diary, and its integration
> with Org always seemed very mysterious to me. But I do think the
> calendar integration is very useful.

Okay, here's a version of how it might work. I've learned a little bit
more about the diary (and as a result will likely use it more! I'd
always thought it was just a poor cousin to Org, but I see it has its
own strengths), and have a solution that is a bit funky, but might be
okay. If Michael or anyone with a better understanding of diary than me
would comment on this, I'd very much appreciate it.

So the user puts "%%(ebdb-diary-anniversaries)" as a sexp in their
diary. That function gets called in two situations: marking dates in the
calendar (it gets called *many* times but only has to return a boolean),
and listing diary entries for a particular date (it only gets called
once, but has to produce more detailed information). The function checks
(bound-and-true-p 'original-date) to know which situation it's in.

At load time EBDB builds some prep data in a hash table, and that data
feels messy, but the strategy is to do a medium amount of work at load
time, the absolute minimum amount of work when marking dates in the
*Calendar* (essentially checks "does this hash key have a value"), and
again a medium amount of work when displaying diary entries for a
particular day.

I would love some feedback on this!

Eric


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: rework-ebdb-diary-anniversaries.diff --]
[-- Type: text/x-patch, Size: 5796 bytes --]

diff --git a/ebdb.el b/ebdb.el
index d3b7d9480a..b5075dfb86 100644
--- a/ebdb.el
+++ b/ebdb.el
@@ -282,6 +282,10 @@ do not set this to nil."
   "Customizations for EBDB utilities."
   :group 'ebdb)
 
+(defgroup ebdb-utilities-anniv nil
+  "Customizations for EBDB anniversaries."
+  :group 'ebdb)
+
 (defgroup ebdb-utilities-dialing nil
   "EBDB customizations for phone number dialing."
   :group 'ebdb-utilities)
@@ -373,6 +377,10 @@ Emacs, always query before reverting."
   :group 'ebdb-utilities-anniv
   :type 'boolean)
 
+(make-obsolete-variable
+ 'ebdb-use-diary
+ "Add %%(ebdb-diary-anniversaries) to your diary file instead" "0.8")
+
 (defcustom ebdb-anniversary-md-format "%B %d"
   "Format string used for displaying month-day anniversary dates.
 See the docstring of `format-time-string' for the meaning of
@@ -389,26 +397,12 @@ month, and day values are available."
   :group 'ebdb-utilities-anniv
   :type 'string)
 
-(defvar ebdb-diary-entries nil
-  "A list of all anniversary diary entries.
-Entries are added and removed in the `ebdb-init-field' and
-`ebdb-delete-field' methods of the `ebdb-field-anniversary'
-class, and added with the `ebdb-diary-add-entries' function.
-
-Each entry is a two-element list: a string representation of the
-anniversary date, and the sexp (as a string):
-
-\(diary-anniversary MM DD YYYY) (the year is optional)")
-
-;; Dynamic var needed by `diary-sexp-entry'.
-(defvar original-date)
-
-(defun ebdb-diary-add-entries ()
-  "Add anniversaries from EBDB to the diary."
-  (pcase-dolist (`(,entry ,sexp) ebdb-diary-entries)
-    (let ((parsed (cdr-safe (diary-sexp-entry sexp entry original-date))))
-      (when parsed
-	(diary-add-to-list original-date parsed sexp)))))
+(defvar ebdb-diary-entries (make-hash-table :test #'equal)
+  "Hash table holding anniversary entries for the diary.
+Keys are dates in the format (MONTH DAY YEAR), values are lists
+of anniversary strings.  Instances of `ebdb-field-anniversary'
+fields can push descriptive strings into the hash entries for
+their dates.  Also see `ebdb-diary-anniversaries'.")
 
 (defcustom ebdb-before-load-hook nil
   "Hook run before loading databases."
@@ -2199,12 +2193,31 @@ Eventually this method will go away."
 				    (list month day year))
 			 obj)))
 
+(defun ebdb-diary-anniversaries (&optional mark)
+  (with-no-warnings
+    (defvar date)
+    (defvar original-date))
+  (when-let ((entries (gethash (seq-subseq date 0 2) ebdb-diary-entries)))
+    (cons mark
+	  (mapconcat (pcase-lambda (`(,entry ,sexp))
+		       (if (bound-and-true-p original-date)
+			   ;; If we have `original-date', we're
+			   ;; displaying the diary list, so we need
+			   ;; the detailed string.
+			   (cdr (diary-sexp-entry
+				 sexp entry original-date))
+			 ;; If not, we're just marking dates on the
+			 ;; calendar, so any non-nil response value is
+			 ;; fine.
+			 entry))
+		     entries "; "))))
+
 ;; `ebdb-field-anniv-diary-entry' is defined below.
 (cl-defmethod ebdb-init-field ((anniv ebdb-field-anniversary) record)
-  (when ebdb-use-diary
-    (add-to-list
-     'ebdb-diary-entries
-     (ebdb-field-anniv-diary-entry anniv record))))
+  (let ((diary-entry (ebdb-field-anniv-diary-entry anniv record))
+	(date (seq-subseq (slot-value anniv 'date)
+			  0 2)))
+    (push diary-entry (gethash date ebdb-diary-entries))))
 
 (cl-defmethod ebdb-string ((ann ebdb-field-anniversary))
   (let* ((date (slot-value ann 'date))
@@ -2226,11 +2239,17 @@ Eventually this method will go away."
 
 (cl-defmethod ebdb-delete-field ((anniv ebdb-field-anniversary)
 				 record &optional _unload)
-  (when ebdb-use-diary
-    (setq
-     ebdb-diary-entries
-     (delete (ebdb-field-anniv-diary-entry anniv record)
-	     ebdb-diary-entries))))
+  (let ((entry-car (car (ebdb-field-anniv-diary-entry anniv record)))
+	(date (seq-subseq (slot-value anniv 'date)
+			  0 2)))
+    (puthash date
+	     (seq-remove (lambda (e)
+			   ;; Use the car of the entry (the text with
+			   ;; the record's name in it) as a key for
+			   ;; removing the whole entry.
+			   (equal entry-car (car e)))
+			 (gethash date ebdb-diary-entries))
+	     ebdb-diary-entries)))
 
 ;;; Id field
 
@@ -3219,18 +3238,17 @@ If FIELD doesn't specify a year, use the current year."
 
 (cl-defmethod ebdb-field-anniv-diary-entry ((field ebdb-field-anniversary)
 					    (record ebdb-record))
-  "Add a diary entry for FIELD's date."
-  (let ((cal-date (slot-value field 'date)))
+  "Produce a diary entry for FIELD's date.
+The return value is added to `ebdb-diary-entries' in the init
+method for the field, and tailored for consumption by
+`ebdb-diary-anniversaries'."
+  (pcase-let ((`(,month ,day ,year) (slot-value field 'date)))
     (list (concat (format "%s's "
 			  (ebdb-string record))
-		  (if (nth 2 cal-date)
-		      "%d%s "
-		    "%s ")
+		  (if year "%d%s " "")
 		  (slot-value field 'label))
-	  (apply #'format (if (nth 2 cal-date)
-			      "(diary-anniversary %s %s %s)"
-			    "(diary-anniversary %s %s)")
-		 cal-date))))
+	  (format "(diary-anniversary %s %s%s)"
+		  month day (if year (format " %s" year) "")))))
 
 ;;; `ebdb-record' subclasses
 
@@ -4338,6 +4356,7 @@ process.")
 	ebdb-record-tracker nil)
   (clrhash ebdb-org-hashtable)
   (clrhash ebdb-hashtable)
+  (clrhash ebdb-diary-entries)
   (clrhash ebdb-relation-hashtable))
 
 ;; Changing which database a record belongs to.
@@ -5372,8 +5391,6 @@ All the important work is done by the `ebdb-db-load' method."
        (cons db-file-regexp 'lisp-data-mode)
        auto-mode-alist))
     (run-hooks 'ebdb-after-load-hook)
-    (when ebdb-use-diary
-      (add-hook 'diary-list-entries-hook #'ebdb-diary-add-entries))
     (add-hook 'kill-emacs-hook #'ebdb-save-on-emacs-exit)
     (length ebdb-record-tracker)))