diff options
Diffstat (limited to 'emacs')
| -rw-r--r-- | emacs/guix-base.el | 69 | ||||
| -rw-r--r-- | emacs/guix-info.el | 54 | ||||
| -rw-r--r-- | emacs/guix-list.el | 176 | ||||
| -rw-r--r-- | emacs/guix.el | 12 |
4 files changed, 277 insertions, 34 deletions
diff --git a/emacs/guix-base.el b/emacs/guix-base.el index 049d976912..98ee315688 100644 --- a/emacs/guix-base.el +++ b/emacs/guix-base.el @@ -87,6 +87,22 @@ Interactively, prompt for PATH. With prefix, use (path . "Installed path") (dependencies . "Dependencies") (output . "Output")) + (output + (id . "ID") + (name . "Name") + (version . "Version") + (license . "License") + (synopsis . "Synopsis") + (description . "Description") + (home-url . "Home page") + (output . "Output") + (inputs . "Inputs") + (native-inputs . "Native inputs") + (propagated-inputs . "Propagated inputs") + (location . "Location") + (installed . "Installed") + (path . "Installed path") + (dependencies . "Dependencies")) (generation (id . "ID") (number . "Number") @@ -130,6 +146,14 @@ Each element of the list has a form: (equal id (guix-get-key-val entry 'id))) entries)) +(defun guix-get-package-id-and-output-by-output-id (oid) + "Return list (PACKAGE-ID OUTPUT) by output id OID." + (cl-multiple-value-bind (pid-str output) + (split-string oid ":") + (let ((pid (string-to-number pid-str))) + (list (if (= 0 pid) pid-str pid) + output)))) + ;;; Location of the packages @@ -227,6 +251,9 @@ The following stuff should be defined outside this macro: Remaining argument (ARGS) should have a form [KEYWORD VALUE] ... The following keywords are available: + - `:buffer-name' - default value for the defined + `guix-TYPE-buffer-name' variable. + - `:required' - default value for the defined `guix-TYPE-required-params' variable. @@ -252,6 +279,7 @@ following keywords are available: (revert-var (intern (concat prefix "-revert-no-confirm"))) (history-var (intern (concat prefix "-history-size"))) (params-var (intern (concat prefix "-required-params"))) + (buf-name-val (format "*Guix %s %s*" Entry-type-str Buf-type-str)) (revert-val nil) (history-val 20) (params-val '(id))) @@ -262,6 +290,7 @@ following keywords are available: (`:required (setq params-val (pop args))) (`:history-size (setq history-val (pop args))) (`:revert (setq revert-val (pop args))) + (`:buffer-name (setq buf-name-val (pop args))) (_ (pop args)))) `(progn @@ -270,8 +299,7 @@ following keywords are available: :prefix ,(concat prefix "-") :group ',(intern (concat "guix-" buf-type-str))) - (defcustom ,buf-name-var ,(format "*Guix %s %s*" - Entry-type-str Buf-type-str) + (defcustom ,buf-name-var ,buf-name-val ,(concat "Default name of the " buf-str " for displaying " entry-str ".") :type 'string :group ',group) @@ -470,8 +498,8 @@ This function will not update the information, use (many "%d newest available packages." count)) (installed (0 "No installed packages.") - (1 "A single installed package.") - (many "%d installed packages." count)) + (1 "A single package installed.") + (many "%d packages installed." count)) (obsolete (0 "No obsolete packages.") (1 "A single obsolete package.") @@ -480,6 +508,39 @@ This function will not update the information, use (0 "No packages installed in generation %d." val) (1 "A single package installed in generation %d." val) (many "%d packages installed in generation %d." count val))) + (output + (id + (0 "Package outputs not found.") + (1 "") + (many "%d package outputs." count)) + (name + (0 "The package output '%s' not found." val) + (1 "A single package output with name '%s'." val) + (many "%d package outputs with '%s' name." count val)) + (regexp + (0 "No package outputs matching '%s'." val) + (1 "A single package output matching '%s'." val) + (many "%d package outputs matching '%s'." count val)) + (all-available + (0 "No package outputs are available for some reason.") + (1 "A single available package output (that's strange).") + (many "%d available package outputs." count)) + (newest-available + (0 "No package outputs are available for some reason.") + (1 "A single newest available package output (that's strange).") + (many "%d newest available package outputs." count)) + (installed + (0 "No installed package outputs.") + (1 "A single package output installed.") + (many "%d package outputs installed." count)) + (obsolete + (0 "No obsolete package outputs.") + (1 "A single obsolete package output.") + (many "%d obsolete package outputs." count)) + (generation + (0 "No package outputs installed in generation %d." val) + (1 "A single package output installed in generation %d." val) + (many "%d package outputs installed in generation %d." count val))) (generation (id (0 "Generations not found.") diff --git a/emacs/guix-info.el b/emacs/guix-info.el index 05281e7be7..f9c17b2d13 100644 --- a/emacs/guix-info.el +++ b/emacs/guix-info.el @@ -117,6 +117,23 @@ number of characters, it will be split into several lines.") guix-info-insert-title-simple) (dependencies guix-package-info-insert-output-dependencies guix-info-insert-title-simple)) + (output + (name guix-package-info-name) + (version guix-output-info-insert-version) + (output guix-output-info-insert-output) + (path guix-package-info-insert-output-path + guix-info-insert-title-simple) + (dependencies guix-package-info-insert-output-dependencies + guix-info-insert-title-simple) + (license guix-package-info-license) + (synopsis guix-package-info-synopsis) + (description guix-package-info-insert-description + guix-info-insert-title-simple) + (home-url guix-info-insert-url) + (inputs guix-package-info-insert-inputs) + (native-inputs guix-package-info-insert-native-inputs) + (propagated-inputs guix-package-info-insert-propagated-inputs) + (location guix-package-info-insert-location)) (generation (number guix-generation-info-insert-number) (path guix-info-insert-file-path) @@ -141,6 +158,8 @@ argument.") (defvar guix-info-displayed-params '((package name version synopsis outputs location home-url license inputs native-inputs propagated-inputs description) + (output name version output synopsis path dependencies location home-url + license inputs native-inputs propagated-inputs description) (installed path dependencies) (generation number prev-number time path)) "List of displayed entry parameters. @@ -520,9 +539,38 @@ ENTRY is an alist with package info." "Insert PATH of the installed output." (guix-info-insert-val-simple path #'guix-info-insert-file-path)) -(defun guix-package-info-insert-output-dependencies (deps &optional _) - "Insert dependencies DEPS of the installed output." - (guix-info-insert-val-simple deps #'guix-info-insert-file-path)) +(defalias 'guix-package-info-insert-output-dependencies + 'guix-package-info-insert-output-path) + + +;;; Displaying outputs + +(guix-define-buffer-type info output + :buffer-name "*Guix Package Info*" + :required (id package-id installed non-unique)) + +(defun guix-output-info-insert-version (version entry) + "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) + (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)) + (action-type (if installed 'delete 'install))) + (guix-info-insert-val-default + output + (if installed + 'guix-package-info-installed-outputs + 'guix-package-info-uninstalled-outputs)) + (guix-info-insert-indent) + (guix-package-info-insert-action-button action-type entry output) + (when obsolete + (guix-info-insert-indent) + (guix-package-info-insert-action-button 'upgrade entry output)))) ;;; Displaying generations diff --git a/emacs/guix-list.el b/emacs/guix-list.el index 3732d9b627..3342175fe3 100644 --- a/emacs/guix-list.el +++ b/emacs/guix-list.el @@ -55,6 +55,12 @@ entries, he will be prompted for confirmation." (outputs 13 t) (installed 13 t) (synopsis 30 nil)) + (output + (name 20 t) + (version 10 nil) + (output 9 t) + (installed 12 t) + (synopsis 30 nil)) (generation (number 5 ,(lambda (a b) (guix-list-sort-numerically 0 a b)) @@ -82,6 +88,10 @@ this list have a priority.") (synopsis . guix-list-get-one-line) (description . guix-list-get-one-line) (installed . guix-package-list-get-installed-outputs)) + (output + (name . guix-package-list-get-name) + (synopsis . guix-list-get-one-line) + (description . guix-list-get-one-line)) (generation (time . guix-list-get-time) (path . guix-list-get-file-path))) @@ -420,20 +430,23 @@ This macro defines the following functions: (put 'guix-list-define-entry-type 'lisp-indent-function 'defun) +(defun guix-list-describe-maybe (entry-type ids) + "Describe ENTRY-TYPE entries in info buffer using list of IDS." + (let ((count (length ids))) + (when (or (<= count guix-list-describe-warning-count) + (y-or-n-p (format "Do you really want to describe %d entries? " + count))) + (apply #'guix-get-show-entries 'info entry-type 'id ids)))) + (defun guix-list-describe (&optional arg) "Describe entries marked with a general mark. If no entries are marked, describe the current entry. With prefix (if ARG is non-nil), describe entries marked with any mark." (interactive "P") - (let* ((ids (or (apply #'guix-list-get-marked-id-list - (unless arg '(general))) - (list (guix-list-current-id)))) - (count (length ids))) - (when (or (<= count guix-list-describe-warning-count) - (y-or-n-p (format "Do you really want to describe %d entries? " - count))) - (apply #'guix-get-show-entries - 'info guix-entry-type 'id ids)))) + (let ((ids (or (apply #'guix-list-get-marked-id-list + (unless arg '(general))) + (list (guix-list-current-id))))) + (guix-list-describe-maybe guix-entry-type ids))) ;;; Displaying packages @@ -456,6 +469,15 @@ With prefix (if ARG is non-nil), describe entries marked with any mark." "Face used if a package is obsolete." :group 'guix-package-list) +(defcustom guix-package-list-type 'output + "Define how to display packages in a list buffer. +May be a symbol `package' or `output' (if `output', display each +output on a separate line; if `package', display each package on +a separate line)." + :type '(choice (const :tag "List of packages" package) + (const :tag "List of outputs" output)) + :group 'guix-package-list) + (defcustom guix-package-list-generation-marking-enabled nil "If non-nil, allow putting marks in a list with 'generation packages'. @@ -499,7 +521,8 @@ Colorize it with `guix-package-list-installed' or (defun guix-package-list-marking-check () "Signal an error if marking is disabled for the current buffer." (when (and (not guix-package-list-generation-marking-enabled) - (derived-mode-p 'guix-package-list-mode) + (or (derived-mode-p 'guix-package-list-mode) + (derived-mode-p 'guix-output-list-mode)) (eq guix-search-type 'generation)) (error "Action marks are disabled for lists of 'generation packages'"))) @@ -563,9 +586,10 @@ be separated with \",\")." (and arg "Output(s) to upgrade: ") installed)))) -(defun guix-package-list-mark-upgrades () - "Mark all obsolete packages for upgrading." - (interactive) +(defun guix-list-mark-package-upgrades (fun) + "Mark all obsolete packages for upgrading. +Use FUN to perform marking of the current line. FUN should +accept an entry as argument." (guix-package-list-marking-check) (let ((obsolete (cl-remove-if-not (lambda (entry) @@ -579,20 +603,32 @@ be separated with \",\")." (equal id (guix-get-key-val entry 'id))) obsolete))) (when entry - (apply #'guix-list-mark - 'upgrade nil - (guix-get-installed-outputs entry)))))))) + (funcall fun entry))))))) -(defun guix-package-list-execute () - "Perform actions on the marked packages." +(defun guix-package-list-mark-upgrades () + "Mark all obsolete packages for upgrading." (interactive) + (guix-list-mark-package-upgrades + (lambda (entry) + (apply #'guix-list-mark + 'upgrade nil + (guix-get-installed-outputs entry))))) + +(defun guix-list-execute-package-actions (fun) + "Perform actions on the marked packages. +Use FUN to define actions suitable for `guix-process-package-actions'. +FUN should accept action-type as argument." (let ((actions (delq nil - (mapcar #'guix-package-list-make-action - '(install delete upgrade))))) + (mapcar fun '(install delete upgrade))))) (if actions (apply #'guix-process-package-actions actions) (user-error "No operations specified")))) +(defun guix-package-list-execute () + "Perform actions on the marked packages." + (interactive) + (guix-list-execute-package-actions #'guix-package-list-make-action)) + (defun guix-package-list-make-action (action-type) "Return action specification for the packages marked with ACTION-TYPE. Return nil, if there are no packages marked with ACTION-TYPE. @@ -601,6 +637,104 @@ The specification is suitable for `guix-process-package-actions'." (and specs (cons action-type specs)))) +;;; Displaying outputs + +(guix-define-buffer-type list output + :buffer-name "*Guix Package List*") + +(guix-list-define-entry-type output + :sort-key name + :marks ((install . ?I) + (upgrade . ?U) + (delete . ?D))) + +(defcustom guix-output-list-describe-type 'package + "Define how to describe outputs in a list buffer. +May be a symbol `package' or `output' (if `output', describe only +marked outputs; if `package', describe all outputs of the marked +packages)." + :type '(choice (const :tag "Describe packages" package) + (const :tag "Describe outputs" output)) + :group 'guix-output-list) + +(let ((map guix-output-list-mode-map)) + (define-key map (kbd "RET") 'guix-output-list-describe) + (define-key map (kbd "x") 'guix-output-list-execute) + (define-key map (kbd "i") 'guix-output-list-mark-install) + (define-key map (kbd "d") 'guix-output-list-mark-delete) + (define-key map (kbd "U") 'guix-output-list-mark-upgrade) + (define-key map (kbd "^") 'guix-output-list-mark-upgrades)) + +(defun guix-output-list-mark-install () + "Mark the current output for installation and move to the next line." + (interactive) + (guix-package-list-marking-check) + (let* ((entry (guix-list-current-entry)) + (installed (guix-get-key-val entry 'installed))) + (if installed + (user-error "This output is already installed") + (guix-list-mark 'install t)))) + +(defun guix-output-list-mark-delete () + "Mark the current output for deletion and move to the next line." + (interactive) + (guix-package-list-marking-check) + (let* ((entry (guix-list-current-entry)) + (installed (guix-get-key-val entry 'installed))) + (if installed + (guix-list-mark 'delete t) + (user-error "This output is not installed")))) + +(defun guix-output-list-mark-upgrade () + "Mark the current output for deletion and move to the next line." + (interactive) + (guix-package-list-marking-check) + (let* ((entry (guix-list-current-entry)) + (installed (guix-get-key-val entry 'installed))) + (or installed + (user-error "This output is not installed")) + (when (or (guix-get-key-val entry 'obsolete) + (y-or-n-p "This output is not obsolete. Try to upgrade it anyway? ")) + (guix-list-mark 'upgrade t)))) + +(defun guix-output-list-mark-upgrades () + "Mark all obsolete package outputs for upgrading." + (interactive) + (guix-list-mark-package-upgrades + (lambda (_) (guix-list-mark 'upgrade)))) + +(defun guix-output-list-execute () + "Perform actions on the marked outputs." + (interactive) + (guix-list-execute-package-actions #'guix-output-list-make-action)) + +(defun guix-output-list-make-action (action-type) + "Return action specification for the outputs marked with ACTION-TYPE. +Return nil, if there are no outputs marked with ACTION-TYPE. +The specification is suitable for `guix-process-output-actions'." + (let ((ids (guix-list-get-marked-id-list action-type))) + (and ids (cons action-type + (mapcar #'guix-get-package-id-and-output-by-output-id + ids))))) + +(defun guix-output-list-describe (&optional arg) + "Describe outputs or packages marked with a general mark. +If no entries are marked, describe the current output or package. +With prefix (if ARG is non-nil), describe entries marked with any mark. +Also see `guix-output-list-describe-type'." + (interactive "P") + (if (eq guix-output-list-describe-type 'output) + (guix-list-describe arg) + (let* ((oids (or (apply #'guix-list-get-marked-id-list + (unless arg '(general))) + (list (guix-list-current-id)))) + (pids (mapcar (lambda (oid) + (car (guix-get-package-id-and-output-by-output-id + oid))) + oids))) + (guix-list-describe-maybe 'package (cl-remove-duplicates pids))))) + + ;;; Displaying generations (guix-define-buffer-type list generation) @@ -618,7 +752,7 @@ The specification is suitable for `guix-process-package-actions'." (defun guix-generation-list-show-packages () "List installed packages for the generation at point." (interactive) - (guix-get-show-entries 'list 'package 'generation + (guix-get-show-entries 'list guix-package-list-type 'generation (guix-list-current-id))) (provide 'guix-list) diff --git a/emacs/guix.el b/emacs/guix.el index 621dd3b22c..f6e2023ea5 100644 --- a/emacs/guix.el +++ b/emacs/guix.el @@ -58,24 +58,24 @@ SEARCH-VALS. Results are displayed in the list buffer, unless a single package is found and `guix-list-single-package' is nil." (let* ((list-params (guix-get-params-for-receiving - 'list 'package)) - (packages (guix-get-entries 'package + 'list guix-package-list-type)) + (packages (guix-get-entries guix-package-list-type search-type search-vals list-params))) (if (or guix-list-single-package (cdr packages)) - (guix-set-buffer packages 'list 'package + (guix-set-buffer packages 'list guix-package-list-type search-type search-vals) (let* ((info-params (guix-get-params-for-receiving - 'info 'package)) + 'info guix-package-list-type)) (packages (if (equal list-params info-params) packages ;; If we don't have required info, we should ;; receive it again - (guix-get-entries 'package + (guix-get-entries guix-package-list-type search-type search-vals info-params)))) - (guix-set-buffer packages 'info 'package + (guix-set-buffer packages 'info guix-package-list-type search-type search-vals))))) (defun guix-get-show-generations (search-type &rest search-vals) |