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)))