[elpa] externals/ebdb b240223 4/7: Rework field sorting

[Eric Abrahamsen]

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

    Rework field sorting
    
    * ebdb.el (ebdb-field-compare): New method for comparing/sorting
      fields. By default, don't change order.
      (ebdb-field-compare): Remove old (unused) function
      `ebdb-sort-mails', and replace with new method for mail fields.
    * ebdb-format.el (ebdb-fmt-sort-fields): Instead of fretting about how
      to correctly sort mails when editing the database, just do the
      sorting at display time. Fields are now sorted first using
      `ebdb-field-compare', then the formatter sort order. Use seq.el
      sorting functions, instead of my homemade bird's nest.
      (ebdb-fmt-process-fields): Make sure combined field instances
      maintain sort order.
---
 ebdb-format.el | 46 ++++++++++++++++++++--------------------------
 ebdb.el        | 27 ++++++++++++++++-----------
 2 files changed, 36 insertions(+), 37 deletions(-)

diff --git a/ebdb-format.el b/ebdb-format.el
index 65e4dbd..3dd7257 100644
--- a/ebdb-format.el
+++ b/ebdb-format.el
@@ -277,35 +277,28 @@ FIELD-STRING1 FIELD-STRING2 ..)."
 (cl-defmethod ebdb-fmt-sort-fields ((fmt ebdb-formatter)
                                    (_record ebdb-record)
                                    field-list)
-  (let ((sort (slot-value fmt 'sort))
-       f acc outlist class)
-    (when sort
-      (dolist (s sort)
-       (if (symbolp s)
-           (progn
-             (setq class (cl--find-class s))
-             (while (setq f (pop field-list))
-               (if (same-class-p f class)
-                   (push f outlist)
-                 (push f acc)))
-             (setq field-list acc
-                   acc nil))
-         ;; We assume this is the "_" value.  Actually, anything
-         ;; would do as a catchall placeholder.
-         (dolist (fld field-list)
-           (setq class (eieio-object-class-name fld))
-           (unless (memq class sort)
-             ;; This isn't enough -- field still need to be grouped
-             ;; by field class.
-             (push fld outlist)))))
-      (setq field-list (nreverse outlist)))
-    field-list))
+  "Sort FIELD-LIST using sort order from FMT.
+First sorts all fields with `ebdb-field-compare', then sorts
+again by the order of each field's class symbol in the 'sort
+slot of FMT."
+  (let* ((sort-order (slot-value fmt 'sort))
+        (catchall (or (seq-position sort-order "_")
+                      (length sort-order)))
+        (sorted (seq-sort #'ebdb-field-compare field-list)))
+
+    (when sort-order
+      (setq sorted
+           (seq-sort-by
+            (lambda (f)
+              (or (seq-position sort-order (eieio-object-class-name f))
+                  catchall))
+            #'< sorted)))
+    sorted))
 
 (cl-defmethod ebdb-fmt-process-fields ((fmt ebdb-formatter)
                                       (_record ebdb-record)
                                       field-list)
   "Process FIELD-LIST for FMT.
-
 At present that means handling the combine and collapse slots of
 FMT.
 
@@ -319,9 +312,10 @@ grouped by field class."
          (if (null (ebdb-class-in-list-p cls combine))
              (push f outlist)
            (push f acc)
-           (while (and field-list (same-class-p (car field-list) 
(eieio-object-class f)))
+           (while (and field-list (same-class-p (car field-list)
+                                                (eieio-object-class f)))
              (push (setq f (pop field-list)) acc))
-           (push `(:class ,cls :style compact :inst ,acc) outlist)
+           (push `(:class ,cls :style compact :inst ,(nreverse acc)) outlist)
            (setq acc nil)))
        (setq field-list (nreverse outlist)
              outlist nil))
diff --git a/ebdb.el b/ebdb.el
index 03f9a37..1b5683e 100644
--- a/ebdb.el
+++ b/ebdb.el
@@ -958,6 +958,13 @@ chance to react somehow.  TYPE is one of the symbols 
'sender or
 in."
   nil)
 
+(cl-defgeneric ebdb-field-compare (field1 field2)
+  "Return non-nil if FIELD1 should be sorted before FIELD2.")
+
+(cl-defmethod ebdb-field-compare (_field1 _field2)
+  "By default, leave order unchanged."
+  nil)
+
 ;;; The UUID field.
 
 ;; This was originally just a string-value slot, but it was such a
@@ -1515,18 +1522,16 @@ first one."
       (setq slots (plist-put slots :aka name)))
     (cl-call-next-method class str slots)))
 
-(defun ebdb-sort-mails (mails)
-  "Sort MAILS by their priority slot.
+(cl-defmethod ebdb-field-compare ((m-left ebdb-field-mail)
+                                 (m-right ebdb-field-mail))
+  "Sort M-LEFT and M-RIGHT by their priority slot.
 Primary sorts before normal sorts before defunct."
-  (sort
-   mails
-   (lambda (l r)
-     (let ((l-p (slot-value l 'priority))
-          (r-p (slot-value r 'priority)))
-       (or (and (eq l-p 'primary)
-               (memq r-p '(normal defunct)))
-          (and (eq l-p 'normal)
-               (eq r-p 'defunct)))))))
+  (let ((l-p (slot-value m-left 'priority))
+       (r-p (slot-value m-right 'priority)))
+    (or (and (memq r-p '(normal defunct))
+            (eq l-p 'primary))
+       (and (eq r-p 'defunct)
+            (eq l-p 'normal)))))
 
 (cl-defmethod cl-print-object ((mail ebdb-field-mail) stream)
   (princ (format "#<%S %s>"