branch: elpa/hyperdrive
commit 328635c1f9349f3b6e680b463cedc0dad3825762
Author: Joseph Turner <jos...@ushin.org>
Commit: Joseph Turner <jos...@ushin.org>
Change: (hyperdrive-directory-sort) Use column name as alist key
This removes the need to use cl-rassoc to get the description.
---
hyperdrive-dir.el | 22 +++++++++++-----------
hyperdrive-lib.el | 22 ++++++++++------------
hyperdrive-vars.el | 24 ++++++++++++------------
3 files changed, 33 insertions(+), 35 deletions(-)
diff --git a/hyperdrive-dir.el b/hyperdrive-dir.el
index 300819e861..342d6c6135 100644
--- a/hyperdrive-dir.el
+++ b/hyperdrive-dir.el
@@ -120,22 +120,22 @@ arguments."
"Return column headers as a string with PREFIX.
Columns are suffixed with up/down arrows according to
`hyperdrive-sort-entries'."
- (pcase-let* ((`(,accessor . ,direction) hyperdrive-directory-sort)
+ (pcase-let* ((`(,column . ,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))
+ (size-header "Size")
+ (mtime-header "Last Modified")
+ (name-header "Name"))
+ (pcase-exhaustive column
+ ('size (cl-callf2 concat arrow size-header))
+ ('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)))
+ ('name (cl-callf concat name-header arrow)))
(concat prefix "\n"
(format "%6s %s %s"
- size-header
+ (propertize size-header 'face 'hyperdrive-column-header)
(format hyperdrive-timestamp-format-string
- mtime-header)
- name-header))))
+ (propertize mtime-header 'face
'hyperdrive-column-header))
+ (propertize name-header 'face
'hyperdrive-column-header)))))
(defun hyperdrive-dir-pp (thing)
"Pretty-print THING.
diff --git a/hyperdrive-lib.el b/hyperdrive-lib.el
index 32a47a0618..1c689964a4 100644
--- a/hyperdrive-lib.el
+++ b/hyperdrive-lib.el
@@ -131,8 +131,9 @@ generated from PATH. When ENCODE is non-nil, encode PATH."
(cl-defun hyperdrive-sort-entries (entries &key (direction
hyperdrive-directory-sort))
"Return ENTRIES sorted by DIRECTION.
See `hyperdrive-directory-sort' for the type of DIRECTION."
- (pcase-let* ((`(,accessor . ,direction) direction)
- ((map (direction sort-function)) (alist-get accessor
hyperdrive-dir-sort-fields)))
+ (pcase-let* ((`(,column . ,direction) direction)
+ ((map (:accessor accessor) (direction sort-function))
+ (alist-get column 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
@@ -1037,20 +1038,17 @@ 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* ((read-answer-short t)
- (choices (mapcar (pcase-lambda (`(,_accessor . ,(map (:desc
desc))))
- (list desc (aref desc 0) (format "Sort by
%s" desc)))
+ (choices (mapcar (lambda (field)
+ (let ((desc (symbol-name (car field))))
+ (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)
+ (column (intern (read-answer "Sort by column: " choices)))
+ (`(,current-column . ,current-direction)
hyperdrive-directory-sort)
+ (direction (if (and (eq column current-column)
(eq current-direction :ascending))
:descending
:ascending)))
- (cons accessor direction)))
+ (cons column 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 a10170d548..413431dd74 100644
--- a/hyperdrive-vars.el
+++ b/hyperdrive-vars.el
@@ -94,23 +94,23 @@ 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 . :ascending)
+(defcustom hyperdrive-directory-sort '(name . :ascending)
+ ;; TODO(doc): Document change.
"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
-appropriate function (e.g. `time-less-p' for
-`hyperdrive-entry-mtime', `<' for `hyperdrive-entry-size',
-etc)."
+Internally, a cons cell of (COLUMN . DIRECTION), the COLUMn being
+one of the directory listing columns (\\+`name', \\+`size', or
+\\+`mtime') and DIRECTION being one of \\+`:ascending' or
+\\+`:descending'."
;; TODO: Consolidate type
- :type '(radio (cons :tag "By name" (const :format "" hyperdrive-entry-name)
+ :type '(radio (cons :tag "By name" (const :format "" name)
(choice :tag "Direction" :value :ascending
(const :tag "Ascending" :ascending)
(const :tag "Descending" :descending)))
- (cons :tag "By size" (const :format "" hyperdrive-entry-size)
+ (cons :tag "By size" (const :format "" size)
(choice :tag "Direction" :value :ascending
(const :tag "Ascending" :ascending)
(const :tag "Descending" :descending)))
- (cons :tag "By date" (const :format "" hyperdrive-entry-mtime)
+ (cons :tag "By date" (const :format "" mtime)
(choice :tag "Direction" :value :ascending
(const :tag "Ascending" :ascending)
(const :tag "Descending" :descending)))))
@@ -292,9 +292,9 @@ values are alists mapping version range starts to plists
with
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))
+ '((name :accessor hyperdrive-entry-name :ascending string< :descending
string>)
+ (size :accessor hyperdrive-entry-size :ascending < :descending
>)
+ (mtime :accessor hyperdrive-entry-mtime :ascending time-less-p :descending
hyperdrive-time-greater-p))
"Fields for sorting hyperdrive directory buffer columns.")
;;;; Footer
