Re: [O] org-bbdb-anniversaries-future

[Michael Welle]

Hello,

Nicolas Goaziou <address@hidden> writes:

> Hello,
>
> Michael Welle <address@hidden> writes:
>
>> Maybe it's a tiny change, if we strip the comments ;). It's not too
>> sophisticated, everyone could have done it.
>
> I definitely think it _is_ a tiny change.
>
> Some comments follow.
thank you for the valuable comments. I think I've incorporated them all.
Furthermore I reworded some of the comments and I introduced a defvar,
so that the point in time, when to switch to the more general
descriptive text isn't hardcoded anymore, but customisable. 


> Also, could you provide a commit message?
----
Make anniversaries' time span information more descriptive in agenda.

* lisp/org-bbdb.el (org-bbdb-anniversary-description): New function.
(org-bbdb-general-anniversary-description-after): New variable.
(org-bbdb-anniversaries-future): Incorporate calculation of the description.
----

Regards
hmw

diff --git a/lisp/org-bbdb.el b/lisp/org-bbdb.el
index f851668..0aa1ddb 100644
--- a/lisp/org-bbdb.el
+++ b/lisp/org-bbdb.el
@@ -138,6 +138,19 @@
   :group 'org-bbdb-anniversaries
   :require 'bbdb)
 
+(defcustom org-bbdb-general-anniversary-description-after 7
+  "When to switch anniversary descriptions to a more general format.
+Anniversary descriptions include the point in time, when the
+anniversary appears.  This is, in its most general form, just the
+date of the anniversary.  Or more specific terms, like 'today',
+'tomorrow' or 'in n days' are used to describe the time span.  If
+the anniversary is ORG-BBDB-GENERAL-ANNIVERSARY-DESCRIPTION-AFTER
+or more days in the future, the general description is used,
+otherwise the more specific description is used."
+  :type  'integer
+  :group 'org-bbdb-anniversaries
+  :require 'bbdb)
+
 (defcustom org-bbdb-anniversary-format-alist
   '(("birthday" .
      (lambda (name years suffix)
@@ -412,7 +425,25 @@ This is used by Org to re-create the anniversary hash 
table."
     (mapcar (lambda (i) (calendar-gregorian-from-absolute (+ abs i)))
            (number-sequence 0 (1- n)))))
 
-;;;###autoload
+(defun org-bbdb-anniversary-description (agenda-date anniv-date)
+  "Return a string used to incorporate into an agenda anniversary entry.
+The calculation of the anniversary description string is based on
+the difference between the anniversary date, given as ANNIV-DATE,
+and the date on which the entry appears in the agenda, given as
+AGENDA-DATE.  This makes it possible to have different entries
+for the same event depending on if it occurs in the next few days
+or far away in the future."
+  (let ((delta (- (calendar-absolute-from-gregorian anniv-date)
+                  (calendar-absolute-from-gregorian agenda-date))))
+
+    (cond
+     ((= delta 0) " -- today\\&")
+     ((= delta 1) " -- tomorrow\\&")
+     ((< delta org-bbdb-general-anniversary-description-after) (format " -- in 
%d days\\&" delta))
+     ((pcase-let ((`(,month ,day ,year) anniv-date))
+       (format " -- %d-%02d-%02d\\&" year month day))))))
+
+
 (defun org-bbdb-anniversaries-future (&optional n)
   "Return list of anniversaries for today and the next n-1 days (default n=7)."
   (let ((n (or n 7)))
@@ -425,19 +456,17 @@ must be positive"))
          ;; Function to annotate text of each element of l with the
          ;; anniversary date d.
          (annotate-descriptions
-          (lambda (d l)
+          (lambda (agenda-date d l)
             (mapcar (lambda (x)
                       ;; The assumption here is that x is a bbdb link
                       ;; of the form [[bbdb:name][description]].
                       ;; This function rather arbitrarily modifies
                       ;; the description by adding the date to it in
                       ;; a fixed format.
-                      (string-match "]]" x)
-                      (replace-match (format " -- %d-%02d-%02d\\&"
-                                             (nth 2 d)
-                                             (nth 0 d)
-                                             (nth 1 d))
-                                     nil nil x))
+                      (let ((desc (org-bbdb-anniversary-description
+                                   agenda-date d)))
+                        (string-match "]]" x)
+                        (replace-match desc nil nil x)))
                     l))))
       ;; Map a function that generates anniversaries for each date
       ;; over the dates and nconc the results into a single list. When
@@ -447,12 +476,13 @@ must be positive"))
       (apply #'nconc
             (mapcar
              (lambda (d)
-               (let ((date d))
+               (let ((agenda-date date)
+                     (date d))
                  ;; Rebind 'date' so that org-bbdb-anniversaries will
                  ;; be fooled into giving us the list for the given
                  ;; date and then annotate the descriptions for that
                  ;; date.
-                 (funcall annotate-descriptions d (org-bbdb-anniversaries))))
+                 (funcall annotate-descriptions agenda-date d 
(org-bbdb-anniversaries))))
              dates)))))
 
 (defun org-bbdb-complete-link ()