mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38: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)
|
(defun guix-get-param-title (entry-type param)
|
||||||
"Return title of an ENTRY-TYPE entry parameter PARAM."
|
"Return title of an ENTRY-TYPE entry parameter PARAM."
|
||||||
(or (guix-get-key-val guix-param-titles
|
(or (guix-assq-value guix-param-titles
|
||||||
entry-type param)
|
entry-type param)
|
||||||
(prog1 (symbol-name param)
|
(prog1 (symbol-name param)
|
||||||
(message "Couldn't find title for '%S %S'."
|
(message "Couldn't find title for '%S %S'."
|
||||||
entry-type param))))
|
entry-type param))))
|
||||||
|
@ -102,15 +102,15 @@ Each element of the list has a form:
|
||||||
|
|
||||||
(defun guix-get-full-name (entry &optional output)
|
(defun guix-get-full-name (entry &optional output)
|
||||||
"Return name specification of the package ENTRY and OUTPUT."
|
"Return name specification of the package ENTRY and OUTPUT."
|
||||||
(guix-get-name-spec (guix-get-key-val entry 'name)
|
(guix-get-name-spec (guix-assq-value entry 'name)
|
||||||
(guix-get-key-val entry 'version)
|
(guix-assq-value entry 'version)
|
||||||
output))
|
output))
|
||||||
|
|
||||||
(defun guix-entry-to-specification (entry)
|
(defun guix-entry-to-specification (entry)
|
||||||
"Return name specification by the package or output ENTRY."
|
"Return name specification by the package or output ENTRY."
|
||||||
(guix-get-name-spec (guix-get-key-val entry 'name)
|
(guix-get-name-spec (guix-assq-value entry 'name)
|
||||||
(guix-get-key-val entry 'version)
|
(guix-assq-value entry 'version)
|
||||||
(guix-get-key-val entry 'output)))
|
(guix-assq-value entry 'output)))
|
||||||
|
|
||||||
(defun guix-entries-to-specifications (entries)
|
(defun guix-entries-to-specifications (entries)
|
||||||
"Return name specifications by the package or output 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)
|
(defun guix-get-installed-outputs (entry)
|
||||||
"Return list of installed outputs for the package ENTRY."
|
"Return list of installed outputs for the package ENTRY."
|
||||||
(mapcar (lambda (installed-entry)
|
(mapcar (lambda (installed-entry)
|
||||||
(guix-get-key-val installed-entry 'output))
|
(guix-assq-value installed-entry 'output))
|
||||||
(guix-get-key-val entry 'installed)))
|
(guix-assq-value entry 'installed)))
|
||||||
|
|
||||||
(defun guix-get-entry-by-id (id entries)
|
(defun guix-get-entry-by-id (id entries)
|
||||||
"Return entry from ENTRIES by entry ID."
|
"Return entry from ENTRIES by entry ID."
|
||||||
(cl-find-if (lambda (entry)
|
(cl-find-if (lambda (entry)
|
||||||
(equal id (guix-get-key-val entry 'id)))
|
(equal id (guix-assq-value entry 'id)))
|
||||||
entries))
|
entries))
|
||||||
|
|
||||||
(defun guix-get-package-id-and-output-by-output-id (oid)
|
(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))
|
(outputs (cdr spec))
|
||||||
(entry (guix-get-entry-by-id id entries)))
|
(entry (guix-get-entry-by-id id entries)))
|
||||||
(when entry
|
(when entry
|
||||||
(let ((location (guix-get-key-val entry 'location)))
|
(let ((location (guix-assq-value entry 'location)))
|
||||||
(concat (guix-get-full-name entry)
|
(concat (guix-get-full-name entry)
|
||||||
(when outputs
|
(when outputs
|
||||||
(concat ":"
|
(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)
|
(defun guix-info-get-insert-methods (entry-type param)
|
||||||
"Return list of insert methods for parameter PARAM of ENTRY-TYPE.
|
"Return list of insert methods for parameter PARAM of ENTRY-TYPE.
|
||||||
See `guix-info-insert-methods' for details."
|
See `guix-info-insert-methods' for details."
|
||||||
(guix-get-key-val guix-info-insert-methods
|
(guix-assq-value guix-info-insert-methods
|
||||||
entry-type param))
|
entry-type param))
|
||||||
|
|
||||||
(defun guix-info-get-displayed-params (entry-type)
|
(defun guix-info-get-displayed-params (entry-type)
|
||||||
"Return parameters of ENTRY-TYPE that should be displayed."
|
"Return parameters of ENTRY-TYPE that should be displayed."
|
||||||
(guix-get-key-val guix-info-displayed-params
|
(guix-assq-value guix-info-displayed-params
|
||||||
entry-type))
|
entry-type))
|
||||||
|
|
||||||
(defun guix-info-get-indent (&optional level)
|
(defun guix-info-get-indent (&optional level)
|
||||||
"Return `guix-info-indent' \"multiplied\" by LEVEL spaces.
|
"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.
|
"Insert title and value of a PARAM at point.
|
||||||
ENTRY is alist with parameters and their values.
|
ENTRY is alist with parameters and their values.
|
||||||
ENTRY-TYPE is a type of ENTRY."
|
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))
|
(unless (and guix-info-ignore-empty-vals (null val))
|
||||||
(let* ((title (guix-get-param-title entry-type param))
|
(let* ((title (guix-get-param-title entry-type param))
|
||||||
(insert-methods (guix-info-get-insert-methods 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)
|
(defun guix-package-info-insert-heading (entry)
|
||||||
"Insert the heading for package ENTRY.
|
"Insert the heading for package ENTRY.
|
||||||
Show package name, version, and `guix-package-info-heading-params'."
|
Show package name, version, and `guix-package-info-heading-params'."
|
||||||
(guix-format-insert (concat (guix-get-key-val entry 'name) " "
|
(guix-format-insert (concat (guix-assq-value entry 'name) " "
|
||||||
(guix-get-key-val entry 'version))
|
(guix-assq-value entry 'version))
|
||||||
'guix-package-info-heading)
|
'guix-package-info-heading)
|
||||||
(insert "\n\n")
|
(insert "\n\n")
|
||||||
(mapc (lambda (param)
|
(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)
|
(face (guix-get-symbol (symbol-name param)
|
||||||
'info 'package)))
|
'info 'package)))
|
||||||
(when val
|
(when val
|
||||||
|
@ -587,10 +587,10 @@ If nil, insert installed info in a default way.")
|
||||||
|
|
||||||
(defun guix-package-info-insert-outputs (outputs entry)
|
(defun guix-package-info-insert-outputs (outputs entry)
|
||||||
"Insert OUTPUTS from package ENTRY at point."
|
"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))
|
(guix-package-info-insert-obsolete-text))
|
||||||
(and (guix-get-key-val entry 'non-unique)
|
(and (guix-assq-value entry 'non-unique)
|
||||||
(guix-get-key-val entry 'installed)
|
(guix-assq-value entry 'installed)
|
||||||
(guix-package-info-insert-non-unique-text
|
(guix-package-info-insert-non-unique-text
|
||||||
(guix-get-full-name entry)))
|
(guix-get-full-name entry)))
|
||||||
(insert "\n")
|
(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
|
Make some fancy text with buttons and additional stuff if the
|
||||||
current OUTPUT is installed (if there is such output in
|
current OUTPUT is installed (if there is such output in
|
||||||
`installed' parameter of a package ENTRY)."
|
`installed' parameter of a package ENTRY)."
|
||||||
(let* ((installed (guix-get-key-val entry 'installed))
|
(let* ((installed (guix-assq-value entry 'installed))
|
||||||
(obsolete (guix-get-key-val entry 'obsolete))
|
(obsolete (guix-assq-value entry 'obsolete))
|
||||||
(installed-entry (cl-find-if
|
(installed-entry (cl-find-if
|
||||||
(lambda (entry)
|
(lambda (entry)
|
||||||
(string= (guix-get-key-val entry 'output)
|
(string= (guix-assq-value entry 'output)
|
||||||
output))
|
output))
|
||||||
installed))
|
installed))
|
||||||
(action-type (if installed-entry 'delete 'install)))
|
(action-type (if installed-entry 'delete 'install)))
|
||||||
|
@ -655,8 +655,8 @@ ENTRY is an alist with package info."
|
||||||
(current-buffer)))
|
(current-buffer)))
|
||||||
(concat type-str " '" full-name "'")
|
(concat type-str " '" full-name "'")
|
||||||
'action-type type
|
'action-type type
|
||||||
'id (or (guix-get-key-val entry 'package-id)
|
'id (or (guix-assq-value entry 'package-id)
|
||||||
(guix-get-key-val entry 'id))
|
(guix-assq-value entry 'id))
|
||||||
'output output)))
|
'output output)))
|
||||||
|
|
||||||
(defun guix-package-info-insert-output-path (path &optional _)
|
(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
|
(entries (cl-substitute-if
|
||||||
new-entry
|
new-entry
|
||||||
(lambda (entry)
|
(lambda (entry)
|
||||||
(equal (guix-get-key-val entry 'id)
|
(equal (guix-assq-value entry 'id)
|
||||||
entry-id))
|
entry-id))
|
||||||
guix-entries
|
guix-entries
|
||||||
:count 1)))
|
:count 1)))
|
||||||
|
@ -746,9 +746,9 @@ SOURCE is a list of URLs."
|
||||||
(guix-info-insert-indent)
|
(guix-info-insert-indent)
|
||||||
(if (null source)
|
(if (null source)
|
||||||
(guix-format-insert nil)
|
(guix-format-insert nil)
|
||||||
(let* ((source-file (guix-get-key-val entry 'source-file))
|
(let* ((source-file (guix-assq-value entry 'source-file))
|
||||||
(entry-id (guix-get-key-val entry 'id))
|
(entry-id (guix-assq-value entry 'id))
|
||||||
(package-id (or (guix-get-key-val entry 'package-id)
|
(package-id (or (guix-assq-value entry 'package-id)
|
||||||
entry-id)))
|
entry-id)))
|
||||||
(if (null source-file)
|
(if (null source-file)
|
||||||
(guix-info-insert-action-button
|
(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."
|
"Insert output VERSION and obsolete text if needed at point."
|
||||||
(guix-info-insert-val-default version
|
(guix-info-insert-val-default version
|
||||||
'guix-package-info-version)
|
'guix-package-info-version)
|
||||||
(and (guix-get-key-val entry 'obsolete)
|
(and (guix-assq-value entry 'obsolete)
|
||||||
(guix-package-info-insert-obsolete-text)))
|
(guix-package-info-insert-obsolete-text)))
|
||||||
|
|
||||||
(defun guix-output-info-insert-output (output entry)
|
(defun guix-output-info-insert-output (output entry)
|
||||||
"Insert OUTPUT and action buttons at point."
|
"Insert OUTPUT and action buttons at point."
|
||||||
(let* ((installed (guix-get-key-val entry 'installed))
|
(let* ((installed (guix-assq-value entry 'installed))
|
||||||
(obsolete (guix-get-key-val entry 'obsolete))
|
(obsolete (guix-assq-value entry 'obsolete))
|
||||||
(action-type (if installed 'delete 'install)))
|
(action-type (if installed 'delete 'install)))
|
||||||
(guix-info-insert-val-default
|
(guix-info-insert-val-default
|
||||||
output
|
output
|
||||||
|
@ -874,7 +874,7 @@ If nil, insert generation in a default way.")
|
||||||
(guix-switch-to-generation guix-profile (button-get btn 'number)
|
(guix-switch-to-generation guix-profile (button-get btn 'number)
|
||||||
(current-buffer)))
|
(current-buffer)))
|
||||||
"Switch to this generation (make it the current one)"
|
"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)
|
(provide 'guix-info)
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
;;; guix-list.el --- List buffers for displaying entries -*- lexical-binding: t -*-
|
;;; 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.
|
;; This file is part of GNU Guix.
|
||||||
|
|
||||||
|
@ -110,13 +110,13 @@ parameters and their values).")
|
||||||
|
|
||||||
(defun guix-list-get-param-title (entry-type param)
|
(defun guix-list-get-param-title (entry-type param)
|
||||||
"Return title of an ENTRY-TYPE entry parameter PARAM."
|
"Return title of an ENTRY-TYPE entry parameter PARAM."
|
||||||
(or (guix-get-key-val guix-list-column-titles
|
(or (guix-assq-value guix-list-column-titles
|
||||||
entry-type param)
|
entry-type param)
|
||||||
(guix-get-param-title entry-type param)))
|
(guix-get-param-title entry-type param)))
|
||||||
|
|
||||||
(defun guix-list-get-column-format (entry-type)
|
(defun guix-list-get-column-format (entry-type)
|
||||||
"Return column format for 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)
|
(defun guix-list-get-displayed-params (entry-type)
|
||||||
"Return list of parameters of ENTRY-TYPE that should be displayed."
|
"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
|
Values are taken from ENTRIES which should have the form of
|
||||||
`guix-entries'."
|
`guix-entries'."
|
||||||
(mapcar (lambda (entry)
|
(mapcar (lambda (entry)
|
||||||
(list (guix-get-key-val entry 'id)
|
(list (guix-assq-value entry 'id)
|
||||||
(guix-list-get-tabulated-entry entry entry-type)))
|
(guix-list-get-tabulated-entry entry entry-type)))
|
||||||
entries))
|
entries))
|
||||||
|
|
||||||
|
@ -180,9 +180,9 @@ Parameters are taken from ENTRY of ENTRY-TYPE."
|
||||||
(guix-list-make-tabulated-vector
|
(guix-list-make-tabulated-vector
|
||||||
entry-type
|
entry-type
|
||||||
(lambda (param _)
|
(lambda (param _)
|
||||||
(let ((val (guix-get-key-val entry param))
|
(let ((val (guix-assq-value entry param))
|
||||||
(fun (guix-get-key-val guix-list-column-value-methods
|
(fun (guix-assq-value guix-list-column-value-methods
|
||||||
entry-type param)))
|
entry-type param)))
|
||||||
(if fun
|
(if fun
|
||||||
(funcall fun val entry)
|
(funcall fun val entry)
|
||||||
(guix-get-string val))))))
|
(guix-get-string val))))))
|
||||||
|
@ -221,7 +221,7 @@ VAL may be nil."
|
||||||
(guix-package-list-mode
|
(guix-package-list-mode
|
||||||
(guix-list-current-id))
|
(guix-list-current-id))
|
||||||
(guix-output-list-mode
|
(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)
|
(defun guix-list-for-each-line (fun &rest args)
|
||||||
"Call FUN with ARGS for each entry line."
|
"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)
|
(defsubst guix-list-get-mark (name)
|
||||||
"Return mark character by its 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)))
|
(error "Mark '%S' not found" name)))
|
||||||
|
|
||||||
(defsubst guix-list-get-mark-string (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'."
|
"Put marks according to `guix-list-mark-alist'."
|
||||||
(guix-list-for-each-line
|
(guix-list-for-each-line
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(let ((mark-name (car (guix-get-key-val guix-list-marked
|
(let ((mark-name (car (guix-assq-value guix-list-marked
|
||||||
(guix-list-current-id)))))
|
(guix-list-current-id)))))
|
||||||
(tabulated-list-put-tag
|
(tabulated-list-put-tag
|
||||||
(guix-list-get-mark-string (or mark-name 'empty)))))))
|
(guix-list-get-mark-string (or mark-name 'empty)))))))
|
||||||
|
|
||||||
|
@ -524,16 +524,16 @@ likely)."
|
||||||
Colorize it with `guix-package-list-installed' or
|
Colorize it with `guix-package-list-installed' or
|
||||||
`guix-package-list-obsolete' if needed."
|
`guix-package-list-obsolete' if needed."
|
||||||
(guix-get-string name
|
(guix-get-string name
|
||||||
(cond ((guix-get-key-val entry 'obsolete)
|
(cond ((guix-assq-value entry 'obsolete)
|
||||||
'guix-package-list-obsolete)
|
'guix-package-list-obsolete)
|
||||||
((guix-get-key-val entry 'installed)
|
((guix-assq-value entry 'installed)
|
||||||
'guix-package-list-installed))))
|
'guix-package-list-installed))))
|
||||||
|
|
||||||
(defun guix-package-list-get-installed-outputs (installed &optional _)
|
(defun guix-package-list-get-installed-outputs (installed &optional _)
|
||||||
"Return string with outputs from INSTALLED entries."
|
"Return string with outputs from INSTALLED entries."
|
||||||
(guix-get-string
|
(guix-get-string
|
||||||
(mapcar (lambda (entry)
|
(mapcar (lambda (entry)
|
||||||
(guix-get-key-val entry 'output))
|
(guix-assq-value entry 'output))
|
||||||
installed)))
|
installed)))
|
||||||
|
|
||||||
(defun guix-package-list-marking-check ()
|
(defun guix-package-list-marking-check ()
|
||||||
|
@ -562,7 +562,7 @@ be separated with \",\")."
|
||||||
(interactive "P")
|
(interactive "P")
|
||||||
(guix-package-list-marking-check)
|
(guix-package-list-marking-check)
|
||||||
(let* ((entry (guix-list-current-entry))
|
(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))
|
(installed (guix-get-installed-outputs entry))
|
||||||
(available (cl-set-difference all installed :test #'string=)))
|
(available (cl-set-difference all installed :test #'string=)))
|
||||||
(or available
|
(or available
|
||||||
|
@ -597,7 +597,7 @@ be separated with \",\")."
|
||||||
(installed (guix-get-installed-outputs entry)))
|
(installed (guix-get-installed-outputs entry)))
|
||||||
(or installed
|
(or installed
|
||||||
(user-error "This package is not 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? "))
|
(y-or-n-p "This package is not obsolete. Try to upgrade it anyway? "))
|
||||||
(guix-package-list-mark-outputs
|
(guix-package-list-mark-outputs
|
||||||
'upgrade installed
|
'upgrade installed
|
||||||
|
@ -611,14 +611,14 @@ accept an entry as argument."
|
||||||
(guix-package-list-marking-check)
|
(guix-package-list-marking-check)
|
||||||
(let ((obsolete (cl-remove-if-not
|
(let ((obsolete (cl-remove-if-not
|
||||||
(lambda (entry)
|
(lambda (entry)
|
||||||
(guix-get-key-val entry 'obsolete))
|
(guix-assq-value entry 'obsolete))
|
||||||
guix-entries)))
|
guix-entries)))
|
||||||
(guix-list-for-each-line
|
(guix-list-for-each-line
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(let* ((id (guix-list-current-id))
|
(let* ((id (guix-list-current-id))
|
||||||
(entry (cl-find-if
|
(entry (cl-find-if
|
||||||
(lambda (entry)
|
(lambda (entry)
|
||||||
(equal id (guix-get-key-val entry 'id)))
|
(equal id (guix-assq-value entry 'id)))
|
||||||
obsolete)))
|
obsolete)))
|
||||||
(when entry
|
(when entry
|
||||||
(funcall fun entry)))))))
|
(funcall fun entry)))))))
|
||||||
|
@ -682,7 +682,7 @@ The specification is suitable for `guix-process-package-actions'."
|
||||||
(interactive)
|
(interactive)
|
||||||
(guix-package-list-marking-check)
|
(guix-package-list-marking-check)
|
||||||
(let* ((entry (guix-list-current-entry))
|
(let* ((entry (guix-list-current-entry))
|
||||||
(installed (guix-get-key-val entry 'installed)))
|
(installed (guix-assq-value entry 'installed)))
|
||||||
(if installed
|
(if installed
|
||||||
(user-error "This output is already installed")
|
(user-error "This output is already installed")
|
||||||
(guix-list--mark 'install t))))
|
(guix-list--mark 'install t))))
|
||||||
|
@ -692,7 +692,7 @@ The specification is suitable for `guix-process-package-actions'."
|
||||||
(interactive)
|
(interactive)
|
||||||
(guix-package-list-marking-check)
|
(guix-package-list-marking-check)
|
||||||
(let* ((entry (guix-list-current-entry))
|
(let* ((entry (guix-list-current-entry))
|
||||||
(installed (guix-get-key-val entry 'installed)))
|
(installed (guix-assq-value entry 'installed)))
|
||||||
(if installed
|
(if installed
|
||||||
(guix-list--mark 'delete t)
|
(guix-list--mark 'delete t)
|
||||||
(user-error "This output is not installed"))))
|
(user-error "This output is not installed"))))
|
||||||
|
@ -702,10 +702,10 @@ The specification is suitable for `guix-process-package-actions'."
|
||||||
(interactive)
|
(interactive)
|
||||||
(guix-package-list-marking-check)
|
(guix-package-list-marking-check)
|
||||||
(let* ((entry (guix-list-current-entry))
|
(let* ((entry (guix-list-current-entry))
|
||||||
(installed (guix-get-key-val entry 'installed)))
|
(installed (guix-assq-value entry 'installed)))
|
||||||
(or installed
|
(or installed
|
||||||
(user-error "This output is not 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? "))
|
(y-or-n-p "This output is not obsolete. Try to upgrade it anyway? "))
|
||||||
(guix-list--mark 'upgrade t))))
|
(guix-list--mark 'upgrade t))))
|
||||||
|
|
||||||
|
@ -777,8 +777,8 @@ VAL is a boolean value."
|
||||||
"Switch current profile to the generation at point."
|
"Switch current profile to the generation at point."
|
||||||
(interactive)
|
(interactive)
|
||||||
(let* ((entry (guix-list-current-entry))
|
(let* ((entry (guix-list-current-entry))
|
||||||
(current (guix-get-key-val entry 'current))
|
(current (guix-assq-value entry 'current))
|
||||||
(number (guix-get-key-val entry 'number)))
|
(number (guix-assq-value entry 'number)))
|
||||||
(if current
|
(if current
|
||||||
(user-error "This generation is already the current one")
|
(user-error "This generation is already the current one")
|
||||||
(guix-switch-to-generation guix-profile number (current-buffer)))))
|
(guix-switch-to-generation guix-profile number (current-buffer)))))
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
;;; guix-messages.el --- Minibuffer messages
|
;;; 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.
|
;; This file is part of GNU Guix.
|
||||||
|
|
||||||
|
@ -186,14 +186,14 @@
|
||||||
(defun guix-result-message (profile entries entry-type
|
(defun guix-result-message (profile entries entry-type
|
||||||
search-type search-vals)
|
search-type search-vals)
|
||||||
"Display an appropriate message after displaying ENTRIES."
|
"Display an appropriate message after displaying ENTRIES."
|
||||||
(let* ((type-spec (guix-get-key-val guix-messages
|
(let* ((type-spec (guix-assq-value guix-messages
|
||||||
entry-type search-type))
|
entry-type search-type))
|
||||||
(fun-or-count-spec (car type-spec)))
|
(fun-or-count-spec (car type-spec)))
|
||||||
(if (functionp fun-or-count-spec)
|
(if (functionp fun-or-count-spec)
|
||||||
(funcall fun-or-count-spec profile entries search-vals)
|
(funcall fun-or-count-spec profile entries search-vals)
|
||||||
(let* ((count (length entries))
|
(let* ((count (length entries))
|
||||||
(count-key (if (> count 1) 'many count))
|
(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))
|
(msg (car msg-spec))
|
||||||
(args (cdr msg-spec)))
|
(args (cdr msg-spec)))
|
||||||
(mapc (lambda (subst)
|
(mapc (lambda (subst)
|
||||||
|
|
|
@ -193,14 +193,6 @@ Return time value."
|
||||||
(require 'org)
|
(require 'org)
|
||||||
(org-read-date nil t nil prompt))
|
(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)
|
(defun guix-find-file (file)
|
||||||
"Find FILE if it exists."
|
"Find FILE if it exists."
|
||||||
(if (file-exists-p file)
|
(if (file-exists-p file)
|
||||||
|
@ -223,6 +215,25 @@ Return nil otherwise."
|
||||||
(or (funcall pred (car lst))
|
(or (funcall pred (car lst))
|
||||||
(guix-any pred (cdr 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
|
;;; Diff
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue