[elpa] externals/ebdb 1cae994 3/4: Provide reverse display and following of relationship fields

[Eric Abrahamsen]

branch: externals/ebdb
commit 1cae9941c43e466dcfe43e2ca8d0a18949f3d23c
Author: Eric Abrahamsen <address@hidden>
Commit: Eric Abrahamsen <address@hidden>

    Provide reverse display and following of relationship fields
    
    * ebdb.el (ebdb-relation-hashtable): New core variable, for reverse
    lookups of relationships.
    (ebdb-init-field, ebdb-delete-field): Update hashtable when creating
    and deleting relationship fields.
    (ebdb-clear-vars): Clear ebdb-relation-hashtable, too.
    (ebdb-record-related): Update this method to use the hashtable to
    always find the "other" record.
    * ebdb-format.el (ebdb-fmt-collect-fields): Also collect relation
    fields pointing at "this" record.
    * ebdb-com.el (ebdb-fmt-field-label, ebdb-fmt-field): Display these
    relation fields correctly.
---
 ebdb-com.el    | 21 +++++++++++++++++++++
 ebdb-format.el |  8 ++++++++
 ebdb.el        | 50 +++++++++++++++++++++++++++++++++++++++++++++-----
 3 files changed, 74 insertions(+), 5 deletions(-)

diff --git a/ebdb-com.el b/ebdb-com.el
index 4e2c38b..b61521b 100644
--- a/ebdb-com.el
+++ b/ebdb-com.el
@@ -550,6 +550,17 @@ choice: that formatter should be selected explicitly."
                                    (_record ebdb-record))
   (format "address (%s)" (ebdb-field-label field)))
 
+(cl-defmethod ebdb-fmt-field-label ((_fmt ebdb-formatter-ebdb)
+                                   (field ebdb-field-relation)
+                                   _style
+                                   &optional (record ebdb-record))
+  ;; If FIELD doesn't belong to RECORD, we're showing a reverse
+  ;; relationship.
+  (let ((rel-id (slot-value field 'rel-uuid)))
+    (if (equal (ebdb-record-uuid record) rel-id)
+       (slot-value field 'rel-label)
+      (ebdb-field-label field))))
+
 (cl-defmethod ebdb-fmt-field :around ((_fmt ebdb-formatter-ebdb)
                                      (field ebdb-field)
                                      _style
@@ -599,6 +610,16 @@ Print the first line, add an ellipsis, and add a tooltip."
   (with-slots (bank-name account-name) field
     (format "%s: %s" bank-name account-name)))
 
+(cl-defmethod ebdb-fmt-field ((_fmt ebdb-formatter-ebdb)
+                             (field ebdb-field-relation)
+                             _style
+                             (record ebdb-record))
+  "Format relation-field FIELD for RECORD.
+If FIELD really belongs to RECORD, display the \"other end\" of
+the relation.  If this RECORD is the \"other end\", display the
+record that actually owns the field."
+  (let ((rec (ebdb-record-related record field)))
+    (ebdb-string rec)))
 
 (cl-defmethod ebdb-fmt-field ((_fmt ebdb-formatter-ebdb)
                              (field ebdb-field-passport)
diff --git a/ebdb-format.el b/ebdb-format.el
index 00fa9ef..b57ccfa 100644
--- a/ebdb-format.el
+++ b/ebdb-format.el
@@ -336,6 +336,14 @@ combined into a single string."
    fmt record
    (append field-list (gethash (ebdb-record-uuid record) ebdb-org-hashtable))))
 
+(cl-defmethod ebdb-fmt-collect-fields ((fmt ebdb-formatter-freeform)
+                                      (record ebdb-record-person)
+                                      &optional field-list)
+  (cl-call-next-method
+   fmt record
+   (append field-list (mapcar #'cdr (gethash (ebdb-record-uuid record)
+                                            ebdb-relation-hashtable)))))
+
 (cl-defmethod ebdb-fmt-sort-fields ((fmt ebdb-formatter-freeform)
                                    (_record ebdb-record)
                                    field-list)
diff --git a/ebdb.el b/ebdb.el
index 1b401e7..27de94b 100644
--- a/ebdb.el
+++ b/ebdb.el
@@ -87,6 +87,11 @@ of (record-uuid . role-field). Hashtable entries are created 
and
 deleted by the `ebdb-init-field' and `ebdb-delete-field' methods
 of the `ebdb-field-role' field class.")
 
+(defvar ebdb-relation-hashtable (make-hash-table :size 500 :test #'equal)
+  "Hash table of record relationships.
+Keys are the related records' UUIDs, values are the relation
+fields themselves.")
+
 ;;; Internal variables
 (eval-and-compile
   (defvar ebdb-debug t
@@ -2090,6 +2095,23 @@ Eventually this method will go away."
        (ebdb-string rec)
       "record not loaded")))
 
+(cl-defmethod ebdb-init-field ((rel ebdb-field-relation) record)
+  "Initialize REL related field for RECORD.
+Adds relation information to the `ebdb-relation-hashtable'."
+  (push (cons (ebdb-record-uuid record) rel)
+       (gethash (slot-value rel 'rel-uuid) ebdb-relation-hashtable)))
+
+(cl-defmethod ebdb-delete-field ((rel ebdb-field-relation) record
+                                &optional unload)
+  "Delete REL related field on RECORD.
+Removes relation information from the
+`ebdb-relation-hashtable'."
+  (setf (gethash (slot-value rel 'rel-uuid)
+                ebdb-relation-hashtable)
+       (delete (cons (ebdb-record-uuid record) rel)
+               (gethash (slot-value rel 'rel-uuid)
+                        ebdb-relation-hashtable))))
+
 ;; Image field
 
 (defclass ebdb-field-image (ebdb-field)
@@ -3346,11 +3368,28 @@ ARGS are passed to `ebdb-compose-mail', and then to
   (let ((name (ebdb-parse ebdb-default-name-class name-string)))
     (ebdb-record-change-name record name)))
 
-(cl-defmethod ebdb-record-related ((_record ebdb-record-person)
+(cl-defmethod ebdb-record-related ((record ebdb-record-person)
                                   (field ebdb-field-relation))
-  (or
-   (ebdb-gethash (slot-value field 'rel-uuid) 'uuid)
-   (signal 'ebdb-related-unfound (list (slot-value field 'rel-uuid)))))
+  "Return the record that's related to RECORD according to FIELD.
+If FIELD is owned by RECORD, return the record pointed to by
+FIELD's `rel-uuid' slot.  Otherwise return the record that owns
+FIELD."
+  ;; The format of the `ebdb-relation-hashtable' could
+  ;; probably be reconsidered, this is a bit gross.  If we do
+  ;; a `rel-uuid' hashtable lookup, the value looks like:
+
+  ;; ((SRC-UUID  . REL-FIELD) (SRC-UUID . REL_FIELD))
+
+  ;; So we get the SRC-UUID via (rassq FIELD HASH_VALUE).
+  (let* ((rel-uuid (slot-value field 'rel-uuid))
+        (target-uuid (if (equal (ebdb-record-uuid record)
+                                rel-uuid)
+                         (car-safe
+                          (rassq field
+                                 (gethash rel-uuid ebdb-relation-hashtable)))
+                       (slot-value field 'rel-uuid))))
+    (or (ebdb-gethash target-uuid 'uuid)
+       (signal 'ebdb-related-unfound (list field)))))
 
 (cl-defmethod ebdb-record-related ((_record ebdb-record-person)
                                   (field ebdb-field-role))
@@ -4165,7 +4204,8 @@ process.")
   (setq ebdb-db-list nil
        ebdb-record-tracker nil)
   (clrhash ebdb-org-hashtable)
-  (clrhash ebdb-hashtable))
+  (clrhash ebdb-hashtable)
+  (clrhash ebdb-relation-hashtable))
 
 ;; Changing which database a record belongs to.