From: Eric Abrahamsen <eric@ericabrahamsen.net>
To: Michael Heerdegen <michael_heerdegen@web.de>
Cc: 49995@debbugs.gnu.org, Pankaj Jangid <pankaj@codeisgreat.org>
Subject: bug#49995: 28.0.50; EBDB Anniversaries do not appear marked in calendar
Date: Sun, 15 Aug 2021 08:57:50 -0700 [thread overview]
Message-ID: <87tujqwvi9.fsf@ericabrahamsen.net> (raw)
In-Reply-To: <87y292wzmy.fsf@ericabrahamsen.net> (Eric Abrahamsen's message of "Sun, 15 Aug 2021 07:28:37 -0700")
[-- Attachment #1: Type: text/plain, Size: 1801 bytes --]
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.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: ebdb-diary-closures.diff --]
[-- Type: text/x-patch, Size: 5900 bytes --]
diff --git a/ebdb.el b/ebdb.el
index d3b7d9480a..7ffe41e097 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,30 @@ 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 ,form))
+ (if (bound-and-true-p original-date)
+ ;; If we have `original-date', we're
+ ;; displaying the diary list, so we need
+ ;; the detailed string.
+ (funcall form)
+ ;; 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 +2238,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 +3237,19 @@ 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)))
- (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))))
+ "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))
+ (entry (concat (format "%s's "
+ (ebdb-string record))
+ (if year "%d%s " "")
+ (slot-value field 'label))))
+ (list entry
+ (lambda ()
+ (calendar-dlet ((entry entry))
+ (cdr (diary-anniversary month day year)))))))
;;; `ebdb-record' subclasses
@@ -4338,6 +4357,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 +5392,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)))
next prev parent reply other threads:[~2021-08-15 15:57 UTC|newest]
Thread overview: 13+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-08-11 7:13 bug#49995: 28.0.50; EBDB Anniversaries do not appear marked in calendar Pankaj Jangid
2021-08-13 19:35 ` Eric Abrahamsen
2021-08-14 15:20 ` Michael Heerdegen
2021-08-14 18:08 ` Eric Abrahamsen
2021-08-15 4:01 ` Eric Abrahamsen
2021-08-15 13:18 ` Michael Heerdegen
2021-08-15 14:28 ` Eric Abrahamsen
2021-08-15 15:57 ` Eric Abrahamsen [this message]
2021-08-15 20:16 ` Eric Abrahamsen
2021-08-17 17:16 ` Michael Heerdegen
2021-08-17 19:45 ` Eric Abrahamsen
2021-08-18 15:57 ` Michael Heerdegen
2021-08-18 17:13 ` Eric Abrahamsen
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87tujqwvi9.fsf@ericabrahamsen.net \
--to=eric@ericabrahamsen.net \
--cc=49995@debbugs.gnu.org \
--cc=michael_heerdegen@web.de \
--cc=pankaj@codeisgreat.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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.