[elpa] externals/ebdb 09e421f 156/350: Rework anniversary/diary integration

[Eric Abrahamsen]

branch: externals/ebdb
commit 09e421f3dfe709091b7e1909d1bb59bb184ecea3
Author: Eric Abrahamsen <address@hidden>
Commit: Eric Abrahamsen <address@hidden>

    Rework anniversary/diary integration
    
    Closes #16
    
    * ebdb-anniv.el: Remove file.
    * ebdb.el (ebdb-anniv-use-diary): New option governing whether or not
      we integrate with the diary.
      (ebdb-anniv-diary-entries, ebdb-init-field, ebdb-delete-field,
      ebdb-field-anniv-diary-entry): If we do, use the init/delete methods
      of anniversary fields to populate the `ebdb-anniv-diary-entries'
      list with entries that will be fed to `diary-add-to-list'.
      (ebdb-anniv-add-entries): Add all entries from
      `ebdb-anniv-diary-entries' to the diary using `diary-add-to-list'.
      (ebdb-load): Add the previous function to the
      `diary-list-entries-hook', if we're using the diary.
    
    There's a lot more customization to provide here, but it should *all*
    be handled in `ebdb-field-anniv-diary-entry' and
    `ebdb-anniv-add-entries'. The basic mechansism shouldn't have to
    change.
---
 ebdb-anniv.el | 162 ----------------------------------------------------------
 ebdb.el       |  66 ++++++++++++++++++++++--
 ebdb.org      |  14 +++++
 3 files changed, 75 insertions(+), 167 deletions(-)

diff --git a/ebdb-anniv.el b/ebdb-anniv.el
deleted file mode 100644
index 9c155cd..0000000
--- a/ebdb-anniv.el
+++ /dev/null
@@ -1,162 +0,0 @@
-;;; ebdb-anniv.el --- Getting anniversaries from EBDB contacts  -*- 
lexical-binding: t; -*-
-
-;; Copyright (C) 2016  Free Software Foundation, Inc.
-
-;; Author: Eric Abrahamsen <address@hidden>
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Support for getting anniversaries (birth, wedding, etc) from EBDB
-;; contacts.
-
-;;; Code:
-
-(require 'ebdb)
-(require 'ebdb-com)
-(require 'diary-lib)
-
-(defcustom ebdb-anniv-alist
-  '((birthday . "%n's %d%s birthday")
-    (wedding  . "%n's %d%s wedding anniversary")
-    (anniversary))
-  "Alist of rules for formatting anniversaries in the diary buffer.
-Each element is of the form (LABEL . FORM).
-LABEL is the xfield where this type of anniversaries is stored.
-FORM is a format string with the following substitutions:
-  %n  name of the record
-  %d  number of years
-  %s  ordinal suffix (st, nd, rd, th) for the year.
-  %t  the optional text following the date string in field LABEL.
-If FORM is nil, use the text following the date string in field LABEL
-as format string."
-  :type '(repeat (cons :tag "Rule"
-                       (symbol :tag "Label")
-                       (choice (string)
-                               (const nil))))
-  :group 'ebdb-utilities-anniv)
-
-;; `ebdb-anniv-diary-entries' becomes a member of  `diary-list-entries-hook'.
-;; When this hook is run by `diary-list-entries', the variable `original-date'
-;; is bound to the value of arg DATE of `diary-list-entries'.
-;; Also, `number' is arg NUMBER of `diary-list-entries'.
-;; `diary-list-entries' selects the entries for NUMBER days starting with DATE.
-
-(defvar original-date) ; defined in diary-lib
-(with-no-warnings (defvar number)) ; defined in diary-lib
-
-;;;###autoload
-(defun ebdb-anniv-diary-entries ()
-  "Add anniversaries from EBDB records to `diary-list-entries'.
-This obeys `calendar-date-style' via `diary-date-forms'.
-To enable this feature, put the following into your .emacs:
-
- \(add-hook 'diary-list-entries-hook 'ebdb-anniv-diary-entries)"
-  ;; Loop over NUMBER dates starting from ORGINAL-DATE.
-  (let* ((num-date (1- (calendar-absolute-from-gregorian original-date)))
-         (end-date (+ num-date number)))
-    (while (<= (setq num-date (1+ num-date)) end-date)
-      (let* ((date (calendar-gregorian-from-absolute num-date))
-             ;; The following variables may be used by `diary-date-forms'.
-             (day (calendar-extract-day date))
-             (month (calendar-extract-month date))
-             (current-year (calendar-extract-year date))
-             (non-leap (and (= month 3) (= day 1)
-                            (not (calendar-leap-year-p current-year))))
-             (dayname (format "%s\\|%s\\.?" (calendar-day-name date)
-                              (calendar-day-name date 'abbrev)))
-             (monthname (format "%s\\|%s" (calendar-month-name month)
-                                (calendar-month-name month 'abbrev)))
-             (day (format "0*%d" day))
-             (month (format "0*%d" month))
-             ;; We could use an explicitly numbered group to match the year.
-             ;; This requires emacs 23.
-             (year "\\([0-9]+\\)\\|\\*")
-             date-forms)
-
-        (dolist (date-form diary-date-forms)
-          ;; Require that the matched date is at the beginning of the string.
-          ;; Use shy groups so that we can grab the year more easily.
-          (push (cons (format "\\`%s?\\(?:%s\\)"
-                              (regexp-quote diary-nonmarking-symbol)
-                              (mapconcat 'eval (if (eq (car date-form) 'backup)
-                                                   (cdr date-form) date-form)
-                                         "\\)\\(?:"))
-                      (eq (car date-form) 'backup))
-                date-forms))
-
-        ;; The anniversary of February 29 is considered to be March 1
-        ;; in non-leap years.  So we search for February 29, too.
-        (when non-leap
-          (let* ((day "0*29") (month "0*2")
-                 (monthname (format "%s\\|%s" (calendar-month-name 2)
-                                    (calendar-month-name 2 'abbrev))))
-            (dolist (date-form diary-date-forms)
-              (push (cons (format "\\`%s?\\(?:%s\\)"
-                                  (regexp-quote diary-nonmarking-symbol)
-                                  (mapconcat 'eval (if (eq (car date-form) 
'backup)
-                                                       (cdr date-form) 
date-form)
-                                             "\\)\\(?:"))
-                          (eq (car date-form) 'backup))
-                    date-forms))))
-
-        (dolist (record (ebdb-records))
-          (dolist (rule ebdb-anniv-alist)
-            (dolist (anniv (ebdb-record-xfield-split record (car rule)))
-              (let ((date-forms date-forms)
-                    (anniv-string (concat anniv " X")) ; for backup forms
-                    (case-fold-search t)
-                    form yy text)
-                (while (setq form (pop date-forms))
-                  (when (string-match (car form) anniv-string)
-                    (setq date-forms nil
-                          yy (match-string 1 anniv-string)
-                          yy (if (and yy (string-match-p "[0-9]+" yy))
-                                 (- current-year (string-to-number yy))
-                               100) ; as in `diary-anniversary'
-                          ;; For backup forms we should search backward in
-                          ;; anniv-string from (match-end 0) for "\\<".
-                          ;; That gets too complicated here!
-                          ;; Yet for the default value of `diary-date-forms'
-                          ;; this would matter only if anniv-string started
-                          ;; with a time. That is rather rare for 
anniversaries.
-                          ;; Then we may simply step backward by one character.
-                          text (substring anniv-string (if (cdr form) ; backup
-                                                           (1- (match-end 0))
-                                                         (match-end 0)) -1)
-                          text (replace-regexp-in-string "\\`[ \t]+" "" text)
-                          text (replace-regexp-in-string "[ \t]+\\'" "" text))
-                    (if (cdr rule)
-                        (setq text (replace-regexp-in-string "%t" text (cdr 
rule))))))
-                ;; Add the anniversaries to `diary-entries-list'.
-                (if (and yy (> yy 0) (< 0 (length text)))
-                    (diary-add-to-list
-                     date
-                     (format
-                      ;; Text substitution similar to `diary-anniversary'.
-                      (replace-regexp-in-string "%n" (ebdb-record-name record) 
text)
-                      yy (diary-ordinal-suffix yy))
-                     ;; It would be nice to have a SPECIFIER that allowed us 
to jump
-                     ;; from the diary display buffer to the respective EBDB 
record.
-                     ;; Yet it seems that diary-lib does not support this for 
us.
-                     ;; So we use instead an empty string.  When clicking on 
the
-                     ;; anniversary entry in the diary display buffer, this 
give us
-                     ;; the message "Unable to locate this diary entry".
-                     ""))))))))))
-
-(add-hook 'diary-list-entries-hook 'ebdb-anniv-diary-entries)
-
-(provide 'ebdb-anniv)
-;;; ebdb-anniv.el ends here
diff --git a/ebdb.el b/ebdb.el
index a8f52a5..83285cd 100644
--- a/ebdb.el
+++ b/ebdb.el
@@ -60,7 +60,10 @@
   (autoload 'ebdb-dwim-mail "ebdb-com")
   (autoload 'ebdb-spec-prefix "ebdb-com")
   (autoload 'ebdb-completing-read-records "ebdb-com")
-  (autoload 'eieio-customize-object "eieio-custom"))
+  (autoload 'eieio-customize-object "eieio-custom")
+  (autoload 'calendar-gregorian-from-absolute "calendar")
+  (autoload 'calendar-read-date "calendar")
+  (autoload 'diary-sexp-entry "diary-lib"))
 
 ;; These are the most important internal variables, holding EBDB's
 ;; data structures.
@@ -199,7 +202,6 @@ Organization names are currently hard-coded to use
 (defgroup ebdb-utilities-anniv nil
   "Customizations for EBDB Anniversaries"
   :group 'ebdb-utilities)
-(put 'ebdb-utilities-anniv 'custom-loads '(ebdb-anniv))
 
 (defgroup ebdb-utilities-ispell nil
   "Customizations for EBDB ispell interface"
@@ -283,7 +285,33 @@ automatically.  If nil or the database has been changed 
inside
 Emacs, always query before reverting."  :group 'ebdb :type
 '(choice (const :tag "Revert unchanged database without querying"
 t)
-                 (const :tag "Ask before reverting database" nil)))
+        (const :tag "Ask before reverting database" nil)))
+
+(defcustom ebdb-use-diary t
+  "If non-nil add anniversary field values to the diary."
+  :group 'ebdb-utilities-anniv
+  :type 'boolean)
+
+(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)")
+
+;; Dynamic var needed by `diary-sexp-entry'.
+(defvar original-date)
+
+(defun ebdb-diary-add-entries ()
+  "Add anniversaries from the EBDB to the diary."
+  (pcase-dolist (`(,entry ,sexp) ebdb-diary-entries)
+    (when-let ((parsed (cdr-safe (diary-sexp-entry sexp entry original-date))))
+      (diary-add-to-list original-date parsed sexp))))
 
 (defcustom ebdb-before-load-hook nil
   "Hook run before loading databases."
@@ -1472,6 +1500,23 @@ first one."
    (calendar-gregorian-from-absolute (slot-value ann 'date))
    nil t))
 
+;; `ebdb-field-anniv-diary-entry' is defined below.
+(cl-defmethod ebdb-init-field ((anniv ebdb-field-anniversary) &optional record)
+  (when (and ebdb-use-diary
+            record)
+    (add-to-list
+     'ebdb-diary-entries
+     (ebdb-field-anniv-diary-entry anniv record))))
+
+(cl-defmethod ebdb-delete-field ((anniv ebdb-field-anniversary)
+                                &optional record unload)
+  (when (and ebdb-use-diary
+            record)
+    (setq
+     ebdb-diary-entries
+     (delete (ebdb-field-anniv-diary-entry anniv record)
+            ebdb-diary-entries))))
+
 ;;; Id field
 
 ;; Used for recording an ID or tax id number.  Ie, national
@@ -1664,8 +1709,6 @@ record uuids.")
     :initarg :number
     :custom string
     :initform "")
-   ;; TODO: issue-date and expiration-date should just be plain
-   ;; strings, this is stupid.
    (issue-date
     :initarg :issue-date
     :type (or nil number))
@@ -2031,6 +2074,17 @@ or actual image data."
   (require 'calendar)
   (message "This isn't done yet."))
 
+(cl-defmethod ebdb-field-anniv-diary-entry ((anniv ebdb-field-anniversary)
+                                           (record ebdb-record))
+  (let ((cal-date (calendar-gregorian-from-absolute
+                  (slot-value anniv 'date))))
+    (list (concat (format "%s's "
+                         (ebdb-string record))
+                 "%d%s "
+                 (slot-value anniv 'object-name))
+         (apply #'format "(diary-anniversary %s %s %s)"
+                cal-date))))
+
 ;;; `ebdb-record' subclasses
 
 (defclass ebdb-record-entity (ebdb-record)
@@ -4334,6 +4388,8 @@ important work is done by the `ebdb-db-load' method."
     ;; Users will expect the same ordering as `ebdb-sources'
     (setq ebdb-db-list (nreverse ebdb-db-list))
     (run-hooks 'ebdb-after-load-hook)
+    (when ebdb-use-diary
+      (add-hook 'diary-list-entries-hook #'ebdb-diary-add-entries))
     (length ebdb-record-tracker)))
 
 ;; If we wanted to make it seem like EBDB was loading faster, we could
diff --git a/ebdb.org b/ebdb.org
index 4e4cf2f..023b479 100644
--- a/ebdb.org
+++ b/ebdb.org
@@ -389,7 +389,21 @@ contact, or prompt to create a new contact, and display it.
   otherwise it snarfs the entire current buffer.  Called as a
   function, it can accept a string as the first argument and snarfs
   that.
+* Diary Integration
+Some EBDB fields hold dates or anniversaries (most notably the
+`ebdb-field-anniversary' field).  It's possible to integrate this
+information with Emacs' diary package (and from there to Org, via the
+`org-agenda-include-diary' option).
 
+- Option ebdb-use-diary
+  If non-nil, EBDB fields with date information will attempt to add
+  that information to the diary.
+
+When viewing the calendar, you can use the "d" key to see diary
+information for that day.
+
+Support for this feature is rudimentary.  More customization options
+are forthcoming.
 * Migration from BBDB
 ** Record Migration
 It's possible to migrate records from a BBDB file.  With your BBDB