branch: externals/ebdb
commit d84b604d57369bfc1202c0540bfce9b329ecad79
Author: Eric Abrahamsen <e...@ericabrahamsen.net>
Commit: Eric Abrahamsen <e...@ericabrahamsen.net>
Flesh out roles and organizations
Organizations can have roles at other organizations.
* ebdb-format.el (ebdb-fmt-record): Display this when formatting
records.
* ebdb.el (ebdb-record-related): This method should also be aware of
this possibility.
---
ebdb-format.el | 22 +++++++++++++++++-----
ebdb.el | 16 +++++++++++-----
2 files changed, 28 insertions(+), 10 deletions(-)
diff --git a/ebdb-format.el b/ebdb-format.el
index 815b51369c..8562d68fd1 100644
--- a/ebdb-format.el
+++ b/ebdb-format.el
@@ -125,7 +125,7 @@
:type list
:initarg :header
:initform '((ebdb-record-person ebdb-field-role ebdb-field-image)
- (ebdb-record-organization ebdb-field-domain ebdb-field-image))
+ (ebdb-record-organization ebdb-field-domain ebdb-field-role
ebdb-field-image))
:documentation "A list of field classes which will be output
in the header of the record, grouped by record class type."))
:abstract t
@@ -332,6 +332,7 @@ combined into a single string."
(cl-defmethod ebdb-fmt-collect-fields ((fmt ebdb-formatter-freeform)
(record ebdb-record-organization)
&optional field-list)
+ "Collect all role fields that point at this organization."
(cl-call-next-method
fmt record
(append field-list (gethash (ebdb-record-uuid record) ebdb-org-hashtable))))
@@ -339,6 +340,7 @@ combined into a single string."
(cl-defmethod ebdb-fmt-collect-fields ((fmt ebdb-formatter-freeform)
(record ebdb-record-person)
&optional field-list)
+ "Collect all relation fields that point at this person."
(cl-call-next-method
fmt record
(append field-list (mapcar #'cdr (gethash (ebdb-record-uuid record)
@@ -414,16 +416,26 @@ multiple instances in a single alist."
(record ebdb-record))
(pcase-let* ((header-classes (cdr (assoc (eieio-object-class-name record)
(slot-value fmt 'header))))
+ (record-uuid (ebdb-record-uuid record))
((map header-fields body-fields)
(seq-group-by
(lambda (f)
;; FIXME: Consider doing the header/body split in
;; `ebdb-fmt-process-fields', we've already got the
;; formatter there.
- (if (ebdb-foo-in-list-p (alist-get 'class f)
- header-classes)
- 'header-fields
- 'body-fields))
+ (let ((cls (alist-get 'class f))
+ (inst (car (alist-get 'inst f))))
+ (if (child-of-class-p cls 'ebdb-field-role)
+ ;; This is all getting super hacky... If the
+ ;; role field is "to" some other record, put
+ ;; it in the header. If it's "to" this
+ ;; record, put it in the body.
+ (if (equal record-uuid (slot-value inst 'record-uuid))
+ 'header-fields
+ 'body-fields)
+ (if (ebdb-foo-in-list-p cls header-classes)
+ 'header-fields
+ 'body-fields))))
(ebdb-fmt-process-fields
fmt record
(ebdb-fmt-sort-fields
diff --git a/ebdb.el b/ebdb.el
index f31d5fa96e..14e47dd27f 100644
--- a/ebdb.el
+++ b/ebdb.el
@@ -1645,7 +1645,7 @@ be considered part of the surname and when not."
:initform '(("Display role relation" . ebdb-follow-related))))
:documentation "This class represents a relationship between
the record which owns this field, and the
- `ebdb-record-organization' pointed to by the \"organization\"
+ `ebdb-record-organization' pointed to by the \"org-uuid\"
slot. The \"mail\" slot holds the record's organizational
email address. The \"fields\" slot holds whatever extra fields
might be relevant to the role."
@@ -3907,11 +3907,17 @@ Currently only works for mail fields."
(ebdb-record-delete-field record m)
(ebdb-init-field r record)))))))
-(cl-defmethod ebdb-record-related ((_record ebdb-record-organization)
+(cl-defmethod ebdb-record-related ((record ebdb-record-organization)
(field ebdb-field-role))
- (or
- (ebdb-gethash (slot-value field 'record-uuid) 'uuid)
- (signal 'ebdb-related-unfound (list (slot-value field 'record-uuid)))))
+ ;; Role fields can point to or from an organization; figure out
+ ;; which this is.
+ (let* ((this-uuid (ebdb-record-uuid record))
+ (rec-uuid (slot-value field 'record-uuid))
+ (org-uuid (slot-value field 'org-uuid))
+ (wanted (if (equal this-uuid rec-uuid) org-uuid rec-uuid)))
+ (or
+ (ebdb-gethash wanted 'uuid)
+ (signal 'ebdb-related-unfound (list wanted)))))
(cl-defmethod ebdb-record-add-org-role ((record ebdb-record-person)
(org ebdb-record-organization)
