[nongnu] elpa/hyperdrive ff71f006dc 02/30: Change: (-directory-sort) Use :ascending and :descending keywords

[ELPA Syncer]

branch: elpa/hyperdrive
commit ff71f006dcbe3d8bc8f729764159ef8804470d37
Author: Joseph Turner <joseph@ushin.org>
Commit: Joseph Turner <joseph@ushin.org>

    Change: (-directory-sort) Use :ascending and :descending keywords
    
    This change consolidates the definitions of sorting predicates, and
    hopefully improves readability.
---
 hyperdrive-dir.el  | 33 +++++++++++++--------------------
 hyperdrive-lib.el  | 50 +++++++++++++++++++++++---------------------------
 hyperdrive-vars.el | 27 ++++++++++++++++-----------
 3 files changed, 52 insertions(+), 58 deletions(-)

diff --git a/hyperdrive-dir.el b/hyperdrive-dir.el
index 840597f83e..150b989fc3 100644
--- a/hyperdrive-dir.el
+++ b/hyperdrive-dir.el
@@ -120,29 +120,22 @@ arguments."
   "Return column headers as a string with PREFIX.
 Columns are suffixed with up/down arrows according to
 `hyperdrive-sort-entries'."
-  (let (name-arrow size-arrow date-arrow)
-    (pcase-exhaustive hyperdrive-directory-sort
-      (`(hyperdrive-entry-name . ,predicate)
-       (setf name-arrow (pcase-exhaustive predicate
-                          ('string< "▲")
-                          ('string> "▼"))))
-      (`(hyperdrive-entry-size . ,predicate)
-       (setf size-arrow (pcase-exhaustive predicate
-                          ('< "▲")
-                          ('> "▼"))))
-      (`(hyperdrive-entry-mtime . ,predicate)
-       (setf date-arrow (pcase-exhaustive predicate
-                          ('time-less-p "▲")
-                          ((pred functionp) "▼")))))
+  (pcase-let* ((`(,accessor . ,direction) hyperdrive-directory-sort)
+               (arrow (if (eq direction :ascending) "▲" "▼"))
+               (size-header (propertize "Size" 'face 
'hyperdrive-column-header))
+               (mtime-header (propertize "Last Modified" 'face 
'hyperdrive-column-header))
+               (name-header (propertize "Name" 'face 
'hyperdrive-column-header)))
+    (pcase-exhaustive accessor
+      ('hyperdrive-entry-size (cl-callf2 concat arrow size-header))
+      ('hyperdrive-entry-mtime (cl-callf2 concat arrow mtime-header))
+      ;; Put the arrow second so that the header doesn't move.
+      ('hyperdrive-entry-name (cl-callf concat name-header arrow)))
     (concat prefix "\n"
             (format "%6s  %s  %s"
-                    (concat size-arrow
-                            (propertize "Size" 'face 
'hyperdrive-column-header))
+                    size-header
                     (format hyperdrive-timestamp-format-string
-                           (concat date-arrow
-                                   (propertize "Last Modified" 'face 
'hyperdrive-column-header)))
-                    (concat (propertize "Name" 'face 'hyperdrive-column-header)
-                            name-arrow)))))
+                           mtime-header)
+                    name-header))))
 
 (defun hyperdrive-dir-pp (thing)
   "Pretty-print THING.
diff --git a/hyperdrive-lib.el b/hyperdrive-lib.el
index 211e8f1cb0..b805c79bc8 100644
--- a/hyperdrive-lib.el
+++ b/hyperdrive-lib.el
@@ -131,12 +131,14 @@ generated from PATH.  When ENCODE is non-nil, encode 
PATH."
 (cl-defun hyperdrive-sort-entries (entries &key (by hyperdrive-directory-sort))
   "Return ENTRIES sorted by BY.
 See `hyperdrive-directory-sort' for the type of BY."
-  (cl-sort entries (lambda (a b)
-                     (cond ((and a b) (funcall (cdr by) a b))
-                           ;; When an entry lacks appropriate metadata
-                           ;; for sorting with BY, put it at the end.
-                           (a t)))
-           :key (car by)))
+  (pcase-let* ((`(,accessor . ,direction) by)
+               ((map (direction sort-function)) (alist-get accessor 
hyperdrive-dir-sort-fields)))
+    (cl-sort entries (lambda (a b)
+                       (cond ((and a b) (funcall sort-function a b))
+                             ;; When an entry lacks appropriate metadata
+                             ;; for sorting with BY, put it at the end.
+                             (a t)))
+             :key accessor)))
 
 ;;;; API
 
@@ -1034,27 +1036,21 @@ DEFAULT and INITIAL-INPUT are passed to `read-string' 
as-is."
 
 (defun hyperdrive-complete-sort ()
   "Return a value for `hyperdrive-directory-sort' selected with completion."
-  (pcase-let* ((fn (pcase-lambda (`(cons :tag ,tag (const :format "" ,accessor)
-                                         (choice :tag "Direction" :value 
,_default-direction
-                                                 (const :tag "Ascending" 
,ascending-predicate)
-                                                 (const :tag "Descending" 
,descending-predicate))))
-                     (list tag accessor ascending-predicate 
descending-predicate)))
-               (columns (mapcar fn (cdr (get 'hyperdrive-directory-sort 
'custom-type))))
-               (read-answer-short t)
-               (choices (cl-loop for (tag . _) in columns
-                                 for name = (substring tag 3)
-                                 for key = (aref name 0)
-                                 collect (cons name (list key tag))))
-               (column-choice (read-answer "Sort by column: " choices))
-               (`(,accessor ,ascending-predicate ,descending-predicate)
-                (alist-get (concat "By " column-choice) columns nil nil 
#'equal))
-               (direction-choice (read-answer "Sort in direction: "
-                                              (list (cons "ascending" (list ?a 
"Ascending"))
-                                                    (cons "descending" (list 
?d "Descending")))))
-               (predicate (pcase direction-choice
-                            ("ascending" ascending-predicate)
-                            ("descending" descending-predicate))))
-    (cons accessor predicate)))
+  (pcase-let* ((read-answer-short t)
+               (choices (mapcar (pcase-lambda (`(,_accessor . ,(map (:desc 
desc))))
+                                  (list desc (aref desc 0) (format "Sort by 
%s" desc)))
+                                hyperdrive-dir-sort-fields))
+               (desc (read-answer "Sort by column: " choices))
+               (`(,accessor . ,(map (:ascending _ascending) (:descending 
_descending)))
+                (cl-rassoc desc hyperdrive-dir-sort-fields
+                           :test (lambda (desc fields-properties)
+                                   (equal desc (map-elt fields-properties 
:desc)))))
+               (`(,current-accessor . ,current-direction) 
hyperdrive-directory-sort)
+               (direction (if (and (eq accessor current-accessor)
+                                   (eq current-direction :ascending))
+                              :descending
+                            :ascending)))
+    (cons accessor direction)))
 
 (cl-defun hyperdrive-put-metadata (hyperdrive &key then)
   "Put HYPERDRIVE's metadata into the appropriate file, then call THEN."
diff --git a/hyperdrive-vars.el b/hyperdrive-vars.el
index e51cf6616a..23256b4f12 100644
--- a/hyperdrive-vars.el
+++ b/hyperdrive-vars.el
@@ -94,7 +94,7 @@ Passed to `display-buffer', which see."
                  (const :tag "Pop up window" (display-buffer-pop-up-window))
                  (sexp :tag "Other")))
 
-(defcustom hyperdrive-directory-sort '(hyperdrive-entry-name . string<)
+(defcustom hyperdrive-directory-sort '(hyperdrive-entry-name . :ascending)
   "Column by which directory entries are sorted.
 Internally, a cons cell of (KEY . PREDICATE), the KEY being the
 `hyperdrive-entry' accessor function and the PREDICATE being the
@@ -102,18 +102,17 @@ appropriate function (e.g. `time-less-p' for
 `hyperdrive-entry-mtime', `<' for `hyperdrive-entry-size',
 etc)."
   :type '(radio (cons :tag "By name" (const :format "" hyperdrive-entry-name)
-                      (choice :tag "Direction" :value string<
-                              (const :tag "Ascending" string<)
-                              (const :tag "Descending" string>)))
+                      (choice :tag "Direction" :value :ascending
+                              (const :tag "Ascending" :ascending)
+                              (const :tag "Descending" :descending)))
                 (cons :tag "By size" (const :format "" hyperdrive-entry-size)
-                      (choice :tag "Direction" :value <
-                              (const :tag "Ascending" <)
-                              (const :tag "Descending" >)))
+                      (choice :tag "Direction" :value :ascending
+                              (const :tag "Ascending" :ascending)
+                              (const :tag "Descending" :descending)))
                 (cons :tag "By date" (const :format "" hyperdrive-entry-mtime)
-                      (choice :tag "Direction" :value time-less-p
-                              (const :tag "Ascending" time-less-p)
-                              (const :tag "Descending" (lambda (a b)
-                                                         (not (time-less-p a 
b))))))))
+                      (choice :tag "Direction" :value :ascending
+                              (const :tag "Ascending" :ascending)
+                              (const :tag "Descending" :descending)))))
 
 (defcustom hyperdrive-history-display-buffer-action
   '(display-buffer-same-window)
@@ -291,6 +290,12 @@ values are alists mapping version range starts to plists 
with
   "Alist mapping MIME types to handler functions.
 Keys are regexps matched against MIME types.")
 
+(defvar hyperdrive-dir-sort-fields
+  '((hyperdrive-entry-name  :desc "name"  :ascending string<     :descending 
string>)
+    (hyperdrive-entry-size  :desc "size"  :ascending <           :descending >)
+    (hyperdrive-entry-mtime :desc "mtime" :ascending time-less-p :descending 
hyperdrive-time-greater-p))
+  "Fields for sorting hyperdrive directory buffer columns.")
+
 ;;;; Footer
 
 (provide 'hyperdrive-vars)