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

[Eric Abrahamsen <eric@ericabrahamsen.net>]

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


On 08/15/21 08:57 AM, Eric Abrahamsen wrote:
> On 08/15/21 07:28 AM, Eric Abrahamsen wrote:
>> On 08/15/21 15:18 PM, Michael Heerdegen wrote:
>>> Eric Abrahamsen <eric@ericabrahamsen.net> writes:
>>>
>>>> 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.
>>>
>>> Looks quite good.
>>
>> Thanks for checking!
>>
>>> I would try to get rid of `diary-anniversary'.  All it does is checking
>>> the date and calling `format' - things that you already do.  You now
>>> effectively get `eval' inside `eval' when calling `diary', you have an
>>> extra layer.  I hope removing that will also get rid of the need to look
>>> at `original-date'.
>>>
>>> [BTW: The only nontrivial thing `diary-anniversary' does is handling of
>>> birthdays on 2/28, you may want to have a look if you need to handle
>>> that case specially.]
>>
>> It seems to me that it isn't `diary-anniversary' that needs to be gotten
>> rid of, so much as `diary-sexp-entry' -- that's the function that's
>> basically just eval'ling a string. If I get rid of `diary-anniversary',
>> I'll basically just end up re-writing it.
>>
>> At init time, instead of building up strings, I could just build up
>> closures holding the appropriate dynamic value for DATE and ENTRY, and
>> calling `diary-anniversary': essentially replace `diary-sexp-entry'.
>> That's at least one less layer.
>
> Just for fun, here's a version with closures. The need for
> `calendar-dlet' (or something that does that job) is unfortunate, and
> maybe sufficient argument for writing my own version of
> `diary-anniversary'. But this was a fun experiment in understanding
> lexical binding and closures.

And, because I apparently have nothing else to do on a weekend, here's a
version that just calls a function directly, nothing fancy. Some overlap
with `diary-anniversary', but nothing terrible. This is probably the
best approach.


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

diff --git a/ebdb.el b/ebdb.el
index d3b7d9480a..3264c77f1e 100644
--- a/ebdb.el
+++ b/ebdb.el
@@ -62,8 +62,7 @@
 (autoload 'widget-group-match "wid-edit")
 (autoload 'ebdb-migrate-from-bbdb "ebdb-migrate")
 (autoload 'eieio-customize-object "eieio-custom")
-(autoload 'diary-sexp-entry "diary-lib")
-(autoload 'diary-add-to-list "diary-lib")
+(autoload 'diary-ordinal-suffix "diary-lib")
 (autoload 'org-agenda-list "org-agenda")
 (autoload 'org-make-tags-matcher "org")
 (defvar ebdb-i18n-countries)
@@ -282,6 +281,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 +376,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 +396,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 +2192,29 @@ Eventually this method will go away."
 				    (list month day year))
 			 obj)))
 
-;; `ebdb-field-anniv-diary-entry' is defined below.
+(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 (`(,field ,record))
+		       (if (bound-and-true-p original-date)
+			   ;; If we have `original-date', we're
+			   ;; displaying the diary list, so we need
+			   ;; the detailed string.
+			   (ebdb-field-anniv-diary-entry
+			    field record (nth 2 date))
+			 ;; If not, we're just marking dates on the
+			 ;; calendar, so any non-nil response value is
+			 ;; fine.
+			 entry))
+		     entries "; "))))
+
 (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))))
+  (with-slots (date) anniv
+    (push (list anniv record)
+	  (gethash (seq-subseq date 0 2) ebdb-diary-entries))))
 
 (cl-defmethod ebdb-string ((ann ebdb-field-anniversary))
   (let* ((date (slot-value ann 'date))
@@ -2226,11 +2236,12 @@ 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))))
+  (with-slots (date) anniv
+    (puthash (seq-subseq date 0 2)
+	     (seq-remove (lambda (e)
+			   (equal e (list anniv record)))
+			 (gethash (seq-subseq date 0 2) ebdb-diary-entries))
+	     ebdb-diary-entries)))
 
 ;;; Id field
 
@@ -3218,19 +3229,22 @@ If FIELD doesn't specify a year, use the current year."
      (format "%d-%d-%d" year (nth 0 date) (nth 1 date)))))
 
 (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)))
-    (list (concat (format "%s's "
-			  (ebdb-string record))
-		  (if (nth 2 cal-date)
-		      "%d%s "
-		    "%s ")
-		  (slot-value field 'label))
-	  (apply #'format (if (nth 2 cal-date)
-			      "(diary-anniversary %s %s %s)"
-			    "(diary-anniversary %s %s)")
-		 cal-date))))
+					    (record ebdb-record)
+					    &optional now-year)
+  "Produce a diary entry for FIELD's date.
+The entry is a string noting how many years have passed for
+RECORD's FIELD anniversary, relative to NOW-YEAR."
+  ;; Essentially a re-write of `diary-anniversary'.
+  (pcase-let* ((`(,month ,day ,year) (slot-value field 'date))
+	       (label (slot-value field 'label))
+	       (num-years (when (and year now-year)
+			    (- now-year year))))
+    (concat (format "%s's " (ebdb-string record))
+	    (when year
+	      (format "%d%s " num-years (diary-ordinal-suffix num-years)))
+	    label
+	    (unless (string= label "birthday")
+	      " anniversary"))))
 
 ;;; `ebdb-record' subclasses
 
@@ -4338,6 +4352,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 +5387,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)))