From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Eric Abrahamsen Newsgroups: gmane.emacs.bugs Subject: bug#49995: 28.0.50; EBDB Anniversaries do not appear marked in calendar Date: Sun, 15 Aug 2021 13:16:57 -0700 Message-ID: <87k0kmwjie.fsf@ericabrahamsen.net> References: <87h7ft5ea2.fsf@ericabrahamsen.net> <877dgogihz.fsf@web.de> <87y293527m.fsf@ericabrahamsen.net> <87bl5zxso8.fsf@ericabrahamsen.net> <871r6uhmn9.fsf@web.de> <87y292wzmy.fsf@ericabrahamsen.net> <87tujqwvi9.fsf@ericabrahamsen.net> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="6199"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (gnu/linux) Cc: 49995@debbugs.gnu.org, Pankaj Jangid To: Michael Heerdegen Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Sun Aug 15 22:18:17 2021 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1mFMaH-0001Ms-8T for geb-bug-gnu-emacs@m.gmane-mx.org; Sun, 15 Aug 2021 22:18:17 +0200 Original-Received: from localhost ([::1]:54508 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mFMaF-0007cC-5J for geb-bug-gnu-emacs@m.gmane-mx.org; Sun, 15 Aug 2021 16:18:15 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:46134) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mFMa2-0007bw-Mn for bug-gnu-emacs@gnu.org; Sun, 15 Aug 2021 16:18:02 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:36287) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mFMa2-0005YW-Fn for bug-gnu-emacs@gnu.org; Sun, 15 Aug 2021 16:18:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mFMa2-0005dh-9Y for bug-gnu-emacs@gnu.org; Sun, 15 Aug 2021 16:18:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Eric Abrahamsen Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sun, 15 Aug 2021 20:18:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 49995 X-GNU-PR-Package: emacs Original-Received: via spool by 49995-submit@debbugs.gnu.org id=B49995.162905862821608 (code B ref 49995); Sun, 15 Aug 2021 20:18:02 +0000 Original-Received: (at 49995) by debbugs.gnu.org; 15 Aug 2021 20:17:08 +0000 Original-Received: from localhost ([127.0.0.1]:47833 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mFMZ9-0005cR-Di for submit@debbugs.gnu.org; Sun, 15 Aug 2021 16:17:07 -0400 Original-Received: from mail.ericabrahamsen.net ([52.70.2.18]:53704) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mFMZ7-0005bM-Q7 for 49995@debbugs.gnu.org; Sun, 15 Aug 2021 16:17:06 -0400 Original-Received: from localhost (c-71-197-184-122.hsd1.wa.comcast.net [71.197.184.122]) (Authenticated sender: eric@ericabrahamsen.net) by mail.ericabrahamsen.net (Postfix) with ESMTPSA id 4EE02FA086; Sun, 15 Aug 2021 20:16:59 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=ericabrahamsen.net; s=mail; t=1629058619; bh=aSisskUWGpsWsyEINPakkAdI5++Yc7VUB32f54tf13c=; h=From:To:Cc:Subject:References:Date:In-Reply-To:From; b=Pp3kgr9XaifWjtlLg887nmkGBcDerjW5i2/qiaTOj2ThvJRhpCociuNVp0CFOm9MG W5zEhvOJe7ATKOMHFB0RuFLnA/AEXkkO8Sv4y3IV8Moqo9hfqZszi6eMK4tppoXbHb G8vl9u/1Q3hotGMli+/6Pccw2x5x2OgIXlxdQKWM= In-Reply-To: <87tujqwvi9.fsf@ericabrahamsen.net> (Eric Abrahamsen's message of "Sun, 15 Aug 2021 08:57:50 -0700") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:211947 Archived-At: --=-=-= Content-Type: text/plain 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 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. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=ebdb-diary-function.diff 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))) --=-=-=--