[elpa] externals/ebdb 4bdf47e 263/350: Get notice routine working

[Eric Abrahamsen]

branch: externals/ebdb
commit 4bdf47e6e8eabbb71595183e498675638ce4a865
Author: Eric Abrahamsen <address@hidden>
Commit: Eric Abrahamsen <address@hidden>

    Get notice routine working
    
    * ebdb.el (ebdb-notice-record): Provide generic and method for
      ebdb-notice-record.
      (ebdb-notice-field): Provide generic, and change calling signature
      to remove the message-headers argument. There's no
      immediately-convenient way to pass the headers in to the method.
    * ebdb-mua.el (ebdb-update-records): Put the ebdb-notice-record call
      in the right place.
    * ebdb-gnorb.el (ebdb-fmt-field, ebdb-notice-field): Fix these two
      methods to work with the new noticing routine.
      (gnorb-ebdb-collect-by-thread): Allow for collecting/opening by
      thread.
      (ebdb-gnorb-lapsed-days): Helper function, stolen from
      article-lapsed-days.
---
 ebdb-gnorb.el | 147 ++++++++++++++++++++++++++++++++++++++--------------------
 ebdb-mua.el   |   6 +--
 ebdb.el       |  40 ++++++++++++----
 3 files changed, 130 insertions(+), 63 deletions(-)

diff --git a/ebdb-gnorb.el b/ebdb-gnorb.el
index 668fa38..e3832af 100644
--- a/ebdb-gnorb.el
+++ b/ebdb-gnorb.el
@@ -63,7 +63,19 @@ this record will not push a link to the message into the 
field."
   :type '(choice (const :tag "Most recently seen" 'seen)
                  (const :tag "Most recently received" 'received)))
 
-(defcustom gnorb-ebdb-message-format "%:count. %:lapsed: %:subject"
+(defcustom gnorb-ebdb-collect-by-thread t
+  "When collecting links to messages, only collect one link per thread.
+
+This option won't work correctly unless `gnus-show-thread' is set
+to t; if it is nil, this option will be ignored.
+
+This also affects how links are followed: when t, following a
+link will display the whole thread."
+
+  :group 'gnorb-ebdb
+  :type 'boolean)
+
+(defcustom gnorb-ebdb-message-format "%:lapsed days: %:subject"
   "How a single message is formatted in the list of recent messages.
 This format string is used in multi-line record display.
 
@@ -72,8 +84,8 @@ date, and the message's count in the list, as an integer. You 
can
 access subject and count using the %:subject and %:count escapes.
 The message date can be formatted using any of the escapes
 mentioned in the docstring of `format-time-string', which see, or
-the escape %:lapsed, which shows how many days ago the message
-was received."
+the escape %:lapsed, which inserts the number of days ago the
+message was received."
 
   :group 'gnorb-ebdb
   :type 'string)
@@ -101,40 +113,62 @@ was received."
                     (ebdb-scan-property 'gnorb-link #'gnorb-ebdb-link-p 1)
                     'gnorb-link))))
     (org-gnus-follow-link (gnorb-ebdb-link-group link)
-                         (gnorb-ebdb-link-id link))))
+                         (gnorb-ebdb-link-id link))
+    (when (and gnus-show-threads
+              gnorb-ebdb-collect-by-thread)
+      (gnus-summary-refer-thread))))
 
 (cl-defmethod ebdb-string ((field gnorb-ebdb-field-messages))
   (format "%d messages" (length (slot-value field 'messages))))
 
+(defun ebdb-gnorb-lapsed-days (date)
+  "Return the number of days between now and DATE."
+  ;; Cribbed/simplified from `article-lapsed-string'.  Need to handle
+  ;; dates in the future, though that's stupid.
+  (let* ((now (current-time))
+        (delta (time-subtract now date))
+        (real-sec (and delta
+                       (+ (* (float (car delta)) 65536)
+                          (cadr delta))))
+        (sec (and delta (abs real-sec))))
+    (floor (/ sec 86400))))
+
 (cl-defmethod ebdb-fmt-field ((fmt ebdb-formatter-ebdb)
                              (field gnorb-ebdb-field-messages)
                              _style
                              (record ebdb-record))
-  ;; Hard-code this for now, we can provide more options later.
-  (let* ((article-time-units '((day . 86400)))
-        (msgs (slot-value field 'messages))
+  (let* ((msgs (slot-value field 'messages))
         (outstring
          (if (= (length msgs) 0)
              "No message yet"
            (mapconcat
             #'identity
-            (let ((count 0))
+            (let ((count 0) str)
               (mapcar
                (lambda (m)
+                 (setq str
+                       (format-time-string
+                        (replace-regexp-in-string
+                         "%:subject" (substring
+                                      (gnorb-ebdb-link-subject m)
+                                      0 (min 30
+                                             (length (gnorb-ebdb-link-subject 
m))))
+                         (replace-regexp-in-string
+                          "%:count" (number-to-string (cl-incf count))
+                          gnorb-ebdb-message-format))
+                        (gnorb-ebdb-link-date m)))
+                 ;; Avoid doing the lapse calculation if not
+                 ;; necessary.  Of course, this is probably more
+                 ;; wasteful than just doing it anyway.
+                 (when (string-match-p "%:lapsed" str)
+                   (setq str
+                         (replace-regexp-in-string
+                          "%:lapsed" (number-to-string
+                                      (ebdb-gnorb-lapsed-days
+                                       (gnorb-ebdb-link-date m)))
+                          str)))
                  (propertize
-                  (format-time-string
-                   (replace-regexp-in-string
-                    "%:lapsed" (article-lapsed-string
-                                (gnorb-ebdb-link-date m) 1)
-                    (replace-regexp-in-string
-                     "%:subject" (substring
-                                  (gnorb-ebdb-link-subject m)
-                                  0 (min 30
-                                         (length (gnorb-ebdb-link-subject m))))
-                     (replace-regexp-in-string
-                      "%:count" (number-to-string (cl-incf count))
-                      gnorb-ebdb-message-format)))
-                   (gnorb-ebdb-link-date m))
+                  str
                   'face 'gnorb-ebdb-link
                   'gnorb-link m))
                msgs))
@@ -142,40 +176,53 @@ was received."
     outstring))
 
 (cl-defmethod ebdb-notice-field ((field gnorb-ebdb-field-messages)
-                                (_type (eql from))
-                                _hdrs
+                                (_type (eql sender))
                                 (record ebdb-record))
   "Used in the `bbdb-notice' to possibly save a link
 to a message into the record's `gnorb-ebdb-messages-field'."
 
-  (when (memq major-mode '(gnus-summary-mode gnus-article-mode))
-    (with-current-buffer gnus-summary-buffer
-      (let* ((val (slot-value field 'messages))
-            (art-no (gnus-summary-article-number))
-            (heads (gnus-summary-article-header art-no))
-            (date (apply 'encode-time
-                         (parse-time-string (mail-header-date heads))))
-            (subject (mail-header-subject heads))
-            (id (mail-header-id heads))
-            (group (gnorb-get-real-group-name
-                    gnus-newsgroup-name
-                    art-no))
-            link)
-       (if (not (and date subject id group))
-           (message "Could not save a link to this message")
-         (setq link (make-gnorb-ebdb-link :subject subject :date date
-                                          :group group :id id))
-         (setq val (cons link (delete link val)))
-         (when (eq gnorb-ebdb-define-recent 'received)
-           (setq val (sort val
+  (with-current-buffer gnus-summary-buffer
+    (let* ((links (slot-value field 'messages))
+          (art-no (gnus-summary-article-number))
+          (heads (gnus-summary-article-header art-no))
+          (date (apply 'encode-time
+                       (parse-time-string (mail-header-date heads))))
+          (refs (gnus-extract-references (mail-header-references heads)))
+          (subject (gnus-simplify-subject (mail-header-subject heads)))
+          (id (mail-header-id heads))
+          (group (gnorb-get-real-group-name
+                  gnus-newsgroup-name
+                  art-no))
+          link)
+      (if (not (and date subject id group))
+         (message "Could not save a link to this message")
+       (setq link (make-gnorb-ebdb-link :subject subject :date date
+                                        :group group :id id))
+       (when (and gnus-show-threads
+                  gnorb-ebdb-collect-by-thread)
+         ;; If the new link has a ref to an earlier link, then don't
+         ;; save the new link, but do update the date of the earlier
+         ;; link. Ie, the new link isn't kept, but it "refreshes" the
+         ;; date of the whole thread.
+         (dolist (l links)
+           (when (member (gnorb-ebdb-link-id l)
+                         refs)
+             (setf (gnorb-ebdb-link-date l) date)
+             ;; We can discard link.
+             (setq link nil))))
+       (when link
+         (setq links (cons link (delete link links))))
+       (when (eq gnorb-ebdb-define-recent 'received)
+         (setq links (sort links
                            (lambda (a b)
                              (time-less-p
-                              (gnorb-bbdb-link-date b)
-                              (gnorb-bbdb-link-date a))))))
-         (setq val (cl-subseq val 0 (min (length val) 
gnorb-ebdb-collect-N-messages)))
-         (ebdb-record-change-field
-          record field
-          (make-instance 'gnorb-ebdb-field-messages
-                         :messages val)))))))
+                              (gnorb-ebdb-link-date b)
+                              (gnorb-ebdb-link-date a))))))
+       (setq links (cl-subseq links 0 (min (length links)
+                                           gnorb-ebdb-collect-N-messages)))
+       (ebdb-record-change-field
+        record field
+        (make-instance 'gnorb-ebdb-field-messages
+                       :messages links))))))
 
 (provide 'ebdb-gnorb)
diff --git a/ebdb-mua.el b/ebdb-mua.el
index 98b16e1..c266003 100644
--- a/ebdb-mua.el
+++ b/ebdb-mua.el
@@ -772,7 +772,8 @@ Usually this function is called by the wrapper 
`ebdb-mua-auto-update'."
                 (setq address-list nil))
                ((not (eq task 'next))
                 (dolist (hit (delq nil (nreverse hits)))
-                  (cl-pushnew hit records :test #'equal))))
+                  (cl-pushnew hit records :test #'equal)
+                  (ebdb-notice-record hit (nth 3 address)))))
          (if (and records (not ebdb-message-all-addresses))
              (setq address-list nil))))
       (setq records
@@ -784,9 +785,6 @@ Usually this function is called by the wrapper 
`ebdb-mua-auto-update'."
     (if (and records (not ebdb-message-all-addresses))
         (setq records (list (car records))))
 
-    (dolist (record records)
-      (ebdb-notice-record record))
-
     records))
 
 ;;; This whole thing could probably be replaced by `map-y-or-n-p'
diff --git a/ebdb.el b/ebdb.el
index fa50561..9a16286 100644
--- a/ebdb.el
+++ b/ebdb.el
@@ -651,17 +651,26 @@ functions to call. Otherwise, call the car of the list."
     (when pair
       (funcall (cdr pair) record field))))
 
+(cl-defgeneric ebdb-notice-field (field &optional type record)
+  "\"Notice\" FIELD.
+
+This means that a message involving RECORD has been viewed, or
+that a MUA has otherwise decided that something significant to
+RECORD has taken place.  It is up to the class of FIELD to decide
+what, if anything, to do about this.
+
+TYPE is a further indicator of how RECORD was noticed: in normal
+MUAs it is one of the symbols 'sender or 'recipient.")
+
 (cl-defmethod ebdb-notice-field ((_field ebdb-field)
-                               &optional _type _message-headers _record)
+                                &optional _type _record)
   "Ask FIELD of RECORD to react to RECORD being \"noticed\".
 
 When the user receives an email from or cc'd to RECORD, that
 record will call `ebdb-notice' on all its fields, and give them a
-chance to react somehow.  TYPE is one of the symbols to, from, or
-cc, indicating which message header the record was found in.
-MESSAGE-HEADERS is a list of all the headers of the incoming
-message."
-  nil)
+chance to react somehow.  TYPE is one of the symbols 'sender or
+'recipient, indicating which message header the record was found
+in."  nil)
 
 ;;; The UUID field.
 
@@ -2063,9 +2072,22 @@ only return fields that are suitable for user editing.")
       (push (cons 'notes notes) f-list)))
   f-list)
 
-(cl-defmethod ebdb-notice-record ((_rec ebdb-record))
-  ;; Implement this later.
-  t)
+(cl-defgeneric ebdb-notice-record (record type)
+  "Inform RECORD that it's been \"noticed\".
+
+TYPE is one of the symbols 'sender or 'recipient, indicating
+RECORD's location in the message headers.")
+
+(cl-defmethod ebdb-notice-record ((rec ebdb-record) type)
+  "Notice REC.
+
+Currently this just means passing on the notice message to all
+REC's `ebdb-field-user' instances, and its notes fields.  Other
+built in fields (mail, phone, address) are not \"noticed\", nor
+is the timestamp updated."
+  (with-slots (fields notes) rec
+    (dolist (f (delq nil (cons notes fields)))
+      (ebdb-notice-field f type rec))))
 
 ;; TODO: rename this to `ebdb-record-name-string', it's confusing.
 (cl-defmethod ebdb-record-name ((record ebdb-record))