mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
emacs: Add and use alist accessors.
* emacs/guix-utils.el (guix-define-alist-accessor): New macro. (guix-assq-value, guix-assoc-value): New functions. (guix-get-key-val): Remove. * emacs/guix-base.el: Replace 'guix-get-key-val' with 'guix-assq-value' everywhere. * emacs/guix-info.el: Likewise. * emacs/guix-list.el: Likewise. * emacs/guix-messages.el: Likewise.
This commit is contained in:
parent
d007d8a10c
commit
51dac38339
5 changed files with 83 additions and 72 deletions
|
@ -89,8 +89,8 @@ Each element of the list has a form:
|
|||
|
||||
(defun guix-get-param-title (entry-type param)
|
||||
"Return title of an ENTRY-TYPE entry parameter PARAM."
|
||||
(or (guix-get-key-val guix-param-titles
|
||||
entry-type param)
|
||||
(or (guix-assq-value guix-param-titles
|
||||
entry-type param)
|
||||
(prog1 (symbol-name param)
|
||||
(message "Couldn't find title for '%S %S'."
|
||||
entry-type param))))
|
||||
|
@ -102,15 +102,15 @@ Each element of the list has a form:
|
|||
|
||||
(defun guix-get-full-name (entry &optional output)
|
||||
"Return name specification of the package ENTRY and OUTPUT."
|
||||
(guix-get-name-spec (guix-get-key-val entry 'name)
|
||||
(guix-get-key-val entry 'version)
|
||||
(guix-get-name-spec (guix-assq-value entry 'name)
|
||||
(guix-assq-value entry 'version)
|
||||
output))
|
||||
|
||||
(defun guix-entry-to-specification (entry)
|
||||
"Return name specification by the package or output ENTRY."
|
||||
(guix-get-name-spec (guix-get-key-val entry 'name)
|
||||
(guix-get-key-val entry 'version)
|
||||
(guix-get-key-val entry 'output)))
|
||||
(guix-get-name-spec (guix-assq-value entry 'name)
|
||||
(guix-assq-value entry 'version)
|
||||
(guix-assq-value entry 'output)))
|
||||
|
||||
(defun guix-entries-to-specifications (entries)
|
||||
"Return name specifications by the package or output ENTRIES."
|
||||
|
@ -120,13 +120,13 @@ Each element of the list has a form:
|
|||
(defun guix-get-installed-outputs (entry)
|
||||
"Return list of installed outputs for the package ENTRY."
|
||||
(mapcar (lambda (installed-entry)
|
||||
(guix-get-key-val installed-entry 'output))
|
||||
(guix-get-key-val entry 'installed)))
|
||||
(guix-assq-value installed-entry 'output))
|
||||
(guix-assq-value entry 'installed)))
|
||||
|
||||
(defun guix-get-entry-by-id (id entries)
|
||||
"Return entry from ENTRIES by entry ID."
|
||||
(cl-find-if (lambda (entry)
|
||||
(equal id (guix-get-key-val entry 'id)))
|
||||
(equal id (guix-assq-value entry 'id)))
|
||||
entries))
|
||||
|
||||
(defun guix-get-package-id-and-output-by-output-id (oid)
|
||||
|
@ -934,7 +934,7 @@ ENTRIES is a list of package entries to get info about packages."
|
|||
(outputs (cdr spec))
|
||||
(entry (guix-get-entry-by-id id entries)))
|
||||
(when entry
|
||||
(let ((location (guix-get-key-val entry 'location)))
|
||||
(let ((location (guix-assq-value entry 'location)))
|
||||
(concat (guix-get-full-name entry)
|
||||
(when outputs
|
||||
(concat ":"
|
||||
|
|
|
@ -178,13 +178,13 @@ The order of displayed parameters is the same as in this list.")
|
|||
(defun guix-info-get-insert-methods (entry-type param)
|
||||
"Return list of insert methods for parameter PARAM of ENTRY-TYPE.
|
||||
See `guix-info-insert-methods' for details."
|
||||
(guix-get-key-val guix-info-insert-methods
|
||||
entry-type param))
|
||||
(guix-assq-value guix-info-insert-methods
|
||||
entry-type param))
|
||||
|
||||
(defun guix-info-get-displayed-params (entry-type)
|
||||
"Return parameters of ENTRY-TYPE that should be displayed."
|
||||
(guix-get-key-val guix-info-displayed-params
|
||||
entry-type))
|
||||
(guix-assq-value guix-info-displayed-params
|
||||
entry-type))
|
||||
|
||||
(defun guix-info-get-indent (&optional level)
|
||||
"Return `guix-info-indent' \"multiplied\" by LEVEL spaces.
|
||||
|
@ -232,7 +232,7 @@ Use `guix-info-insert-ENTRY-TYPE-function' or
|
|||
"Insert title and value of a PARAM at point.
|
||||
ENTRY is alist with parameters and their values.
|
||||
ENTRY-TYPE is a type of ENTRY."
|
||||
(let ((val (guix-get-key-val entry param)))
|
||||
(let ((val (guix-assq-value entry param)))
|
||||
(unless (and guix-info-ignore-empty-vals (null val))
|
||||
(let* ((title (guix-get-param-title entry-type param))
|
||||
(insert-methods (guix-info-get-insert-methods entry-type param))
|
||||
|
@ -492,12 +492,12 @@ filling them to fit the window."
|
|||
(defun guix-package-info-insert-heading (entry)
|
||||
"Insert the heading for package ENTRY.
|
||||
Show package name, version, and `guix-package-info-heading-params'."
|
||||
(guix-format-insert (concat (guix-get-key-val entry 'name) " "
|
||||
(guix-get-key-val entry 'version))
|
||||
(guix-format-insert (concat (guix-assq-value entry 'name) " "
|
||||
(guix-assq-value entry 'version))
|
||||
'guix-package-info-heading)
|
||||
(insert "\n\n")
|
||||
(mapc (lambda (param)
|
||||
(let ((val (guix-get-key-val entry param))
|
||||
(let ((val (guix-assq-value entry param))
|
||||
(face (guix-get-symbol (symbol-name param)
|
||||
'info 'package)))
|
||||
(when val
|
||||
|
@ -587,10 +587,10 @@ If nil, insert installed info in a default way.")
|
|||
|
||||
(defun guix-package-info-insert-outputs (outputs entry)
|
||||
"Insert OUTPUTS from package ENTRY at point."
|
||||
(and (guix-get-key-val entry 'obsolete)
|
||||
(and (guix-assq-value entry 'obsolete)
|
||||
(guix-package-info-insert-obsolete-text))
|
||||
(and (guix-get-key-val entry 'non-unique)
|
||||
(guix-get-key-val entry 'installed)
|
||||
(and (guix-assq-value entry 'non-unique)
|
||||
(guix-assq-value entry 'installed)
|
||||
(guix-package-info-insert-non-unique-text
|
||||
(guix-get-full-name entry)))
|
||||
(insert "\n")
|
||||
|
@ -617,11 +617,11 @@ If nil, insert installed info in a default way.")
|
|||
Make some fancy text with buttons and additional stuff if the
|
||||
current OUTPUT is installed (if there is such output in
|
||||
`installed' parameter of a package ENTRY)."
|
||||
(let* ((installed (guix-get-key-val entry 'installed))
|
||||
(obsolete (guix-get-key-val entry 'obsolete))
|
||||
(let* ((installed (guix-assq-value entry 'installed))
|
||||
(obsolete (guix-assq-value entry 'obsolete))
|
||||
(installed-entry (cl-find-if
|
||||
(lambda (entry)
|
||||
(string= (guix-get-key-val entry 'output)
|
||||
(string= (guix-assq-value entry 'output)
|
||||
output))
|
||||
installed))
|
||||
(action-type (if installed-entry 'delete 'install)))
|
||||
|
@ -655,8 +655,8 @@ ENTRY is an alist with package info."
|
|||
(current-buffer)))
|
||||
(concat type-str " '" full-name "'")
|
||||
'action-type type
|
||||
'id (or (guix-get-key-val entry 'package-id)
|
||||
(guix-get-key-val entry 'id))
|
||||
'id (or (guix-assq-value entry 'package-id)
|
||||
(guix-assq-value entry 'id))
|
||||
'output output)))
|
||||
|
||||
(defun guix-package-info-insert-output-path (path &optional _)
|
||||
|
@ -720,7 +720,7 @@ PACKAGE-ID is an ID of the package which source to show."
|
|||
(entries (cl-substitute-if
|
||||
new-entry
|
||||
(lambda (entry)
|
||||
(equal (guix-get-key-val entry 'id)
|
||||
(equal (guix-assq-value entry 'id)
|
||||
entry-id))
|
||||
guix-entries
|
||||
:count 1)))
|
||||
|
@ -746,9 +746,9 @@ SOURCE is a list of URLs."
|
|||
(guix-info-insert-indent)
|
||||
(if (null source)
|
||||
(guix-format-insert nil)
|
||||
(let* ((source-file (guix-get-key-val entry 'source-file))
|
||||
(entry-id (guix-get-key-val entry 'id))
|
||||
(package-id (or (guix-get-key-val entry 'package-id)
|
||||
(let* ((source-file (guix-assq-value entry 'source-file))
|
||||
(entry-id (guix-assq-value entry 'id))
|
||||
(package-id (or (guix-assq-value entry 'package-id)
|
||||
entry-id)))
|
||||
(if (null source-file)
|
||||
(guix-info-insert-action-button
|
||||
|
@ -798,13 +798,13 @@ If nil, insert output in a default way.")
|
|||
"Insert output VERSION and obsolete text if needed at point."
|
||||
(guix-info-insert-val-default version
|
||||
'guix-package-info-version)
|
||||
(and (guix-get-key-val entry 'obsolete)
|
||||
(and (guix-assq-value entry 'obsolete)
|
||||
(guix-package-info-insert-obsolete-text)))
|
||||
|
||||
(defun guix-output-info-insert-output (output entry)
|
||||
"Insert OUTPUT and action buttons at point."
|
||||
(let* ((installed (guix-get-key-val entry 'installed))
|
||||
(obsolete (guix-get-key-val entry 'obsolete))
|
||||
(let* ((installed (guix-assq-value entry 'installed))
|
||||
(obsolete (guix-assq-value entry 'obsolete))
|
||||
(action-type (if installed 'delete 'install)))
|
||||
(guix-info-insert-val-default
|
||||
output
|
||||
|
@ -874,7 +874,7 @@ If nil, insert generation in a default way.")
|
|||
(guix-switch-to-generation guix-profile (button-get btn 'number)
|
||||
(current-buffer)))
|
||||
"Switch to this generation (make it the current one)"
|
||||
'number (guix-get-key-val entry 'number))))
|
||||
'number (guix-assq-value entry 'number))))
|
||||
|
||||
(provide 'guix-info)
|
||||
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
;;; guix-list.el --- List buffers for displaying entries -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright © 2014 Alex Kost <alezost@gmail.com>
|
||||
;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
|
@ -110,13 +110,13 @@ parameters and their values).")
|
|||
|
||||
(defun guix-list-get-param-title (entry-type param)
|
||||
"Return title of an ENTRY-TYPE entry parameter PARAM."
|
||||
(or (guix-get-key-val guix-list-column-titles
|
||||
entry-type param)
|
||||
(or (guix-assq-value guix-list-column-titles
|
||||
entry-type param)
|
||||
(guix-get-param-title entry-type param)))
|
||||
|
||||
(defun guix-list-get-column-format (entry-type)
|
||||
"Return column format for ENTRY-TYPE."
|
||||
(guix-get-key-val guix-list-column-format entry-type))
|
||||
(guix-assq-value guix-list-column-format entry-type))
|
||||
|
||||
(defun guix-list-get-displayed-params (entry-type)
|
||||
"Return list of parameters of ENTRY-TYPE that should be displayed."
|
||||
|
@ -170,7 +170,7 @@ ENTRIES should have a form of `guix-entries'."
|
|||
Values are taken from ENTRIES which should have the form of
|
||||
`guix-entries'."
|
||||
(mapcar (lambda (entry)
|
||||
(list (guix-get-key-val entry 'id)
|
||||
(list (guix-assq-value entry 'id)
|
||||
(guix-list-get-tabulated-entry entry entry-type)))
|
||||
entries))
|
||||
|
||||
|
@ -180,9 +180,9 @@ Parameters are taken from ENTRY of ENTRY-TYPE."
|
|||
(guix-list-make-tabulated-vector
|
||||
entry-type
|
||||
(lambda (param _)
|
||||
(let ((val (guix-get-key-val entry param))
|
||||
(fun (guix-get-key-val guix-list-column-value-methods
|
||||
entry-type param)))
|
||||
(let ((val (guix-assq-value entry param))
|
||||
(fun (guix-assq-value guix-list-column-value-methods
|
||||
entry-type param)))
|
||||
(if fun
|
||||
(funcall fun val entry)
|
||||
(guix-get-string val))))))
|
||||
|
@ -221,7 +221,7 @@ VAL may be nil."
|
|||
(guix-package-list-mode
|
||||
(guix-list-current-id))
|
||||
(guix-output-list-mode
|
||||
(guix-get-key-val (guix-list-current-entry) 'package-id))))
|
||||
(guix-assq-value (guix-list-current-entry) 'package-id))))
|
||||
|
||||
(defun guix-list-for-each-line (fun &rest args)
|
||||
"Call FUN with ARGS for each entry line."
|
||||
|
@ -262,7 +262,7 @@ ARGS is a list of additional values.")
|
|||
|
||||
(defsubst guix-list-get-mark (name)
|
||||
"Return mark character by its NAME."
|
||||
(or (guix-get-key-val guix-list-mark-alist name)
|
||||
(or (guix-assq-value guix-list-mark-alist name)
|
||||
(error "Mark '%S' not found" name)))
|
||||
|
||||
(defsubst guix-list-get-mark-string (name)
|
||||
|
@ -355,8 +355,8 @@ With ARG, unmark all lines."
|
|||
"Put marks according to `guix-list-mark-alist'."
|
||||
(guix-list-for-each-line
|
||||
(lambda ()
|
||||
(let ((mark-name (car (guix-get-key-val guix-list-marked
|
||||
(guix-list-current-id)))))
|
||||
(let ((mark-name (car (guix-assq-value guix-list-marked
|
||||
(guix-list-current-id)))))
|
||||
(tabulated-list-put-tag
|
||||
(guix-list-get-mark-string (or mark-name 'empty)))))))
|
||||
|
||||
|
@ -524,16 +524,16 @@ likely)."
|
|||
Colorize it with `guix-package-list-installed' or
|
||||
`guix-package-list-obsolete' if needed."
|
||||
(guix-get-string name
|
||||
(cond ((guix-get-key-val entry 'obsolete)
|
||||
(cond ((guix-assq-value entry 'obsolete)
|
||||
'guix-package-list-obsolete)
|
||||
((guix-get-key-val entry 'installed)
|
||||
((guix-assq-value entry 'installed)
|
||||
'guix-package-list-installed))))
|
||||
|
||||
(defun guix-package-list-get-installed-outputs (installed &optional _)
|
||||
"Return string with outputs from INSTALLED entries."
|
||||
(guix-get-string
|
||||
(mapcar (lambda (entry)
|
||||
(guix-get-key-val entry 'output))
|
||||
(guix-assq-value entry 'output))
|
||||
installed)))
|
||||
|
||||
(defun guix-package-list-marking-check ()
|
||||
|
@ -562,7 +562,7 @@ be separated with \",\")."
|
|||
(interactive "P")
|
||||
(guix-package-list-marking-check)
|
||||
(let* ((entry (guix-list-current-entry))
|
||||
(all (guix-get-key-val entry 'outputs))
|
||||
(all (guix-assq-value entry 'outputs))
|
||||
(installed (guix-get-installed-outputs entry))
|
||||
(available (cl-set-difference all installed :test #'string=)))
|
||||
(or available
|
||||
|
@ -597,7 +597,7 @@ be separated with \",\")."
|
|||
(installed (guix-get-installed-outputs entry)))
|
||||
(or installed
|
||||
(user-error "This package is not installed"))
|
||||
(when (or (guix-get-key-val entry 'obsolete)
|
||||
(when (or (guix-assq-value entry 'obsolete)
|
||||
(y-or-n-p "This package is not obsolete. Try to upgrade it anyway? "))
|
||||
(guix-package-list-mark-outputs
|
||||
'upgrade installed
|
||||
|
@ -611,14 +611,14 @@ accept an entry as argument."
|
|||
(guix-package-list-marking-check)
|
||||
(let ((obsolete (cl-remove-if-not
|
||||
(lambda (entry)
|
||||
(guix-get-key-val entry 'obsolete))
|
||||
(guix-assq-value entry 'obsolete))
|
||||
guix-entries)))
|
||||
(guix-list-for-each-line
|
||||
(lambda ()
|
||||
(let* ((id (guix-list-current-id))
|
||||
(entry (cl-find-if
|
||||
(lambda (entry)
|
||||
(equal id (guix-get-key-val entry 'id)))
|
||||
(equal id (guix-assq-value entry 'id)))
|
||||
obsolete)))
|
||||
(when entry
|
||||
(funcall fun entry)))))))
|
||||
|
@ -682,7 +682,7 @@ The specification is suitable for `guix-process-package-actions'."
|
|||
(interactive)
|
||||
(guix-package-list-marking-check)
|
||||
(let* ((entry (guix-list-current-entry))
|
||||
(installed (guix-get-key-val entry 'installed)))
|
||||
(installed (guix-assq-value entry 'installed)))
|
||||
(if installed
|
||||
(user-error "This output is already installed")
|
||||
(guix-list--mark 'install t))))
|
||||
|
@ -692,7 +692,7 @@ The specification is suitable for `guix-process-package-actions'."
|
|||
(interactive)
|
||||
(guix-package-list-marking-check)
|
||||
(let* ((entry (guix-list-current-entry))
|
||||
(installed (guix-get-key-val entry 'installed)))
|
||||
(installed (guix-assq-value entry 'installed)))
|
||||
(if installed
|
||||
(guix-list--mark 'delete t)
|
||||
(user-error "This output is not installed"))))
|
||||
|
@ -702,10 +702,10 @@ The specification is suitable for `guix-process-package-actions'."
|
|||
(interactive)
|
||||
(guix-package-list-marking-check)
|
||||
(let* ((entry (guix-list-current-entry))
|
||||
(installed (guix-get-key-val entry 'installed)))
|
||||
(installed (guix-assq-value entry 'installed)))
|
||||
(or installed
|
||||
(user-error "This output is not installed"))
|
||||
(when (or (guix-get-key-val entry 'obsolete)
|
||||
(when (or (guix-assq-value entry 'obsolete)
|
||||
(y-or-n-p "This output is not obsolete. Try to upgrade it anyway? "))
|
||||
(guix-list--mark 'upgrade t))))
|
||||
|
||||
|
@ -777,8 +777,8 @@ VAL is a boolean value."
|
|||
"Switch current profile to the generation at point."
|
||||
(interactive)
|
||||
(let* ((entry (guix-list-current-entry))
|
||||
(current (guix-get-key-val entry 'current))
|
||||
(number (guix-get-key-val entry 'number)))
|
||||
(current (guix-assq-value entry 'current))
|
||||
(number (guix-assq-value entry 'number)))
|
||||
(if current
|
||||
(user-error "This generation is already the current one")
|
||||
(guix-switch-to-generation guix-profile number (current-buffer)))))
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
;;; guix-messages.el --- Minibuffer messages
|
||||
|
||||
;; Copyright © 2014 Alex Kost <alezost@gmail.com>
|
||||
;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
|
@ -186,14 +186,14 @@
|
|||
(defun guix-result-message (profile entries entry-type
|
||||
search-type search-vals)
|
||||
"Display an appropriate message after displaying ENTRIES."
|
||||
(let* ((type-spec (guix-get-key-val guix-messages
|
||||
entry-type search-type))
|
||||
(let* ((type-spec (guix-assq-value guix-messages
|
||||
entry-type search-type))
|
||||
(fun-or-count-spec (car type-spec)))
|
||||
(if (functionp fun-or-count-spec)
|
||||
(funcall fun-or-count-spec profile entries search-vals)
|
||||
(let* ((count (length entries))
|
||||
(count-key (if (> count 1) 'many count))
|
||||
(msg-spec (guix-get-key-val type-spec count-key))
|
||||
(msg-spec (guix-assq-value type-spec count-key))
|
||||
(msg (car msg-spec))
|
||||
(args (cdr msg-spec)))
|
||||
(mapc (lambda (subst)
|
||||
|
|
|
@ -193,14 +193,6 @@ Return time value."
|
|||
(require 'org)
|
||||
(org-read-date nil t nil prompt))
|
||||
|
||||
(defun guix-get-key-val (alist &rest keys)
|
||||
"Return value from ALIST by KEYS.
|
||||
ALIST is alist of alists of alists ... which can be consecutively
|
||||
accessed with KEYS."
|
||||
(let ((val alist))
|
||||
(dolist (key keys val)
|
||||
(setq val (cdr (assq key val))))))
|
||||
|
||||
(defun guix-find-file (file)
|
||||
"Find FILE if it exists."
|
||||
(if (file-exists-p file)
|
||||
|
@ -223,6 +215,25 @@ Return nil otherwise."
|
|||
(or (funcall pred (car lst))
|
||||
(guix-any pred (cdr lst)))))
|
||||
|
||||
|
||||
;;; Alist accessors
|
||||
|
||||
(defmacro guix-define-alist-accessor (name assoc-fun)
|
||||
"Define NAME function to access alist values using ASSOC-FUN."
|
||||
`(defun ,name (alist &rest keys)
|
||||
,(format "Return value from ALIST by KEYS using `%s'.
|
||||
ALIST is alist of alists of alists ... which can be consecutively
|
||||
accessed with KEYS."
|
||||
assoc-fun)
|
||||
(if (or (null alist) (null keys))
|
||||
alist
|
||||
(apply #',name
|
||||
(cdr (,assoc-fun (car keys) alist))
|
||||
(cdr keys)))))
|
||||
|
||||
(guix-define-alist-accessor guix-assq-value assq)
|
||||
(guix-define-alist-accessor guix-assoc-value assoc)
|
||||
|
||||
|
||||
;;; Diff
|
||||
|
||||
|
|
Loading…
Reference in a new issue