emacs: list: Generalize 'sort-key' code.

* emacs/guix-list.el (guix-list-sort-key): New procedure.
  (guix-list-tabulated-sort-key): Use it.
  (guix-list-define-entry-type): Generate
  'guix-ENTRY-TYPE-list-sort-key' variables.
This commit is contained in:
Alex Kost 2015-11-19 16:19:47 +03:00
parent 7b31510f26
commit 649df66705

View file

@ -136,6 +136,10 @@ This alist is filled by `guix-list-define-entry-type' macro.")
"Return a list of ENTRY-TYPE parameters that should be displayed." "Return a list of ENTRY-TYPE parameters that should be displayed."
(mapcar #'car (guix-list-format entry-type))) (mapcar #'car (guix-list-format entry-type)))
(defun guix-list-sort-key (entry-type)
"Return sort key for ENTRY-TYPE."
(guix-list-value entry-type 'sort-key))
(defun guix-list-additional-marks (entry-type) (defun guix-list-additional-marks (entry-type)
"Return alist of additional marks for ENTRY-TYPE." "Return alist of additional marks for ENTRY-TYPE."
(guix-list-value entry-type 'marks)) (guix-list-value entry-type 'marks))
@ -182,12 +186,12 @@ See `guix-list-define-numerical-sorter' for details."
(guix-list-define-numerical-sorters 9) (guix-list-define-numerical-sorters 9)
(defun guix-list-tabulated-sort-key (entry-type param &optional invert) (defun guix-list-tabulated-sort-key (entry-type)
"Return suitable sort key for `tabulated-list-sort-key'. "Return ENTRY-TYPE sort key for `tabulated-list-sort-key'."
Define column title by ENTRY-TYPE and PARAM. If INVERT is (let ((sort-key (guix-list-sort-key entry-type)))
non-nil, invert the sort." (and sort-key
(when (memq param (guix-list-displayed-params entry-type)) (cons (guix-list-param-title entry-type (car sort-key))
(cons (guix-list-param-title entry-type param) invert))) (cdr sort-key)))))
(defun guix-list-tabulated-vector (entry-type fun) (defun guix-list-tabulated-vector (entry-type fun)
"Call FUN on each column specification for ENTRY-TYPE. "Call FUN on each column specification for ENTRY-TYPE.
@ -450,9 +454,8 @@ Same as `tabulated-list-sort', but also restore marks after sorting."
Remaining argument (ARGS) should have a form [KEYWORD VALUE] ... The Remaining argument (ARGS) should have a form [KEYWORD VALUE] ... The
following keywords are available: following keywords are available:
- `:sort-key' - default sort key for the tabulated list buffer. - `:sort-key' - default value of the generated
`guix-ENTRY-TYPE-list-sort-key' variable.
- `:invert-sort' - if non-nil, invert initial sort.
- `:describe-function' - default value of the generated - `:describe-function' - default value of the generated
`guix-ENTRY-TYPE-describe-function' variable. `guix-ENTRY-TYPE-describe-function' variable.
@ -468,14 +471,28 @@ following keywords are available:
(describe-var (intern (concat prefix "-describe-function"))) (describe-var (intern (concat prefix "-describe-function")))
(describe-count-var (intern (concat prefix (describe-count-var (intern (concat prefix
"-describe-warning-count"))) "-describe-warning-count")))
(sort-key-var (intern (concat prefix "-sort-key")))
(marks-var (intern (concat prefix "-marks")))) (marks-var (intern (concat prefix "-marks"))))
(guix-keyword-args-let args (guix-keyword-args-let args
((describe-val :describe-function) ((describe-val :describe-function)
(describe-count-val :describe-count 10) (describe-count-val :describe-count 10)
(sort-key :sort-key) (sort-key-val :sort-key)
(invert-sort :invert-sort)
(marks-val :marks)) (marks-val :marks))
`(progn `(progn
(defcustom ,sort-key-var ,sort-key-val
,(format "\
Default sort key for 'list' buffer with '%s' entries.
Should be nil (no sort) or have a form:
(PARAM . FLIP)
PARAM is the name of '%s' entry parameter. For the meaning of
FLIP, see `tabulated-list-sort-key'."
entry-type-str entry-type-str)
:type '(choice (const :tag "No sort" nil)
(cons symbol boolean))
:group ',group)
(defvar ,marks-var ,marks-val (defvar ,marks-var ,marks-val
,(format "\ ,(format "\
Alist of additional marks for 'list' buffer with '%s' entries. Alist of additional marks for 'list' buffer with '%s' entries.
@ -498,18 +515,17 @@ See also `guix-list-describe'."
(defun ,init-fun () (defun ,init-fun ()
,(concat "Initial settings for `" mode-str "'.") ,(concat "Initial settings for `" mode-str "'.")
,(when sort-key (setq tabulated-list-sort-key (guix-list-tabulated-sort-key
`(setq tabulated-list-sort-key ',entry-type)
(guix-list-tabulated-sort-key tabulated-list-format (guix-list-tabulated-format
',entry-type ',sort-key ,invert-sort))) ',entry-type))
(setq tabulated-list-format
(guix-list-tabulated-format ',entry-type))
(setq-local guix-list-marks (guix-list-marks ',entry-type)) (setq-local guix-list-marks (guix-list-marks ',entry-type))
(tabulated-list-init-header)) (tabulated-list-init-header))
(guix-alist-put! (guix-alist-put!
'((describe . ,describe-var) '((describe . ,describe-var)
(describe-count . ,describe-count-var) (describe-count . ,describe-count-var)
(sort-key . ,sort-key-var)
(marks . ,marks-var)) (marks . ,marks-var))
'guix-list-data ',entry-type))))) 'guix-list-data ',entry-type)))))
@ -527,7 +543,7 @@ See also `guix-list-describe'."
(guix-list-define-entry-type package (guix-list-define-entry-type package
:describe-function 'guix-list-describe-ids :describe-function 'guix-list-describe-ids
:sort-key name :sort-key '(name)
:marks '((install . ?I) :marks '((install . ?I)
(upgrade . ?U) (upgrade . ?U)
(delete . ?D))) (delete . ?D)))
@ -711,7 +727,7 @@ The specification is suitable for `guix-process-package-actions'."
(guix-list-define-entry-type output (guix-list-define-entry-type output
:describe-function 'guix-output-list-describe :describe-function 'guix-output-list-describe
:sort-key name :sort-key '(name)
:marks '((install . ?I) :marks '((install . ?I)
(upgrade . ?U) (upgrade . ?U)
(delete . ?D))) (delete . ?D)))
@ -797,8 +813,7 @@ See `guix-package-info-type'."
(guix-list-define-entry-type generation (guix-list-define-entry-type generation
:describe-function 'guix-list-describe-ids :describe-function 'guix-list-describe-ids
:sort-key number :sort-key '(number . t)
:invert-sort t
:marks '((delete . ?D))) :marks '((delete . ?D)))
(let ((map guix-generation-list-mode-map)) (let ((map guix-generation-list-mode-map))