diff options
| author | Alex Kost <alezost@gmail.com> | 2015-12-09 14:44:34 +0300 |
|---|---|---|
| committer | Alex Kost <alezost@gmail.com> | 2016-01-02 17:25:35 +0300 |
| commit | c80ce104bed39157347078020cbc45c65ff9b893 (patch) | |
| tree | a6151b01dd94994065716c1edffba2fd9578c23b /emacs | |
| parent | b1990426fdec1b0047a115116ac686c6dd4d4884 (diff) | |
emacs: Reorganize package/generation UI code.
Move the code for packages/generations interface from "guix-info.el",
"guix-list.el", "guix-base.el" and "guix.el" to "guix-ui-package.el" and
"guix-ui-generation.el".
* emacs/guix-base.el (guix-package-entry->name-specification)
(guix-package-entries->name-specifications)
(guix-package-id-and-output-by-output-id)
(guix-package-installed-outputs, guix-process-package-actions)
(guix-package-list-type, guix-package-info-type)
(guix-continue-package-operation-p, guix-get-package-strings)
(guix-insert-package-strings): Move to "guix-ui-package.el".
(guix-generation-packages-buffer-name-function, guix-output-name-width)
(guix-generation-packages-update-buffer, guix-generation-packages)
(guix-generation-packages-buffer-name-default)
(guix-generation-packages-buffer-name-long)
(guix-generation-packages-buffer-name, guix-generation-packages-buffer)
(guix-generation-insert-packages, guix-generation-insert-package)
(guix-profile-generation-manifest-file, guix-delete-generations)
(guix-profile-generation-packages-buffer, guix-switch-to-generation):
Move to "guix-ui-generation.el".
* emacs/guix-info.el (guix-package-location, guix-package-name)
(guix-package-source, guix-package-info-source)
(guix-package-info-heading, guix-package-info-license)
(guix-package-info-name, guix-package-info-name-button)
(guix-package-info-version, guix-package-info-location)
(guix-package-info-synopsis, guix-package-info-description)
(guix-package-info-obsolete, guix-package-info-installed-outputs)
(guix-package-info-uninstalled-outputs)
(guix-package-info-insert-heading)
(guix-package-info-define-insert-inputs)
(guix-package-info-obsolete-string)
(guix-package-info-insert-obsolete-text)
(guix-package-info-insert-non-unique-text)
(guix-package-info-insert-outputs, guix-package-info-insert-output)
(guix-package-info-insert-action-button)
(guix-package-info-auto-find-source)
(guix-package-info-auto-download-source)
(guix-package-info-download-buffer, guix-package-info-show-source)
(guix-package-info-download-source, guix-package-info-insert-source)
(guix-package-info-redisplay-after-download)
(guix-output-info-insert-version, guix-output-info-insert-output):
Move to "guix-ui-package.el".
(guix-generation-info-number, guix-generation-info-current)
(guix-generation-not-current, guix-generation-info-insert-number)
(guix-generation-info-insert-current): Move to "guix-ui-generation.el".
* emacs/guix-list.el (guix-package-list-generation-marking-enabled)
(guix-package-list-installed, guix-package-list-obsolete)
(guix-package-list-get-name, guix-package-list-get-installed-outputs)
(guix-package-list-marking-check, guix-package-list-mark-outputs)
(guix-package-list-mark-install, guix-package-list-mark-delete)
(guix-package-list-mark-upgrade, guix-package-list-mark-upgrades)
(guix-list-mark-package-upgrades, guix-list-execute-package-actions)
(guix-package-list-execute, guix-package-list-make-action)
(guix-package-list-edit, guix-output-list-mark-install)
(guix-output-list-mark-delete, guix-output-list-mark-upgrade)
(guix-output-list-mark-upgrades, guix-output-list-make-action)
(guix-output-list-describe, guix-output-list-edit): Move to
"guix-ui-package.el".
(guix-generation-list-get-current, guix-generation-list-switch)
(guix-generation-list-generations-to-compare)
(guix-generation-list-compare, guix-generation-list-show-packages)
(guix-generation-list-show-added-packages)
(guix-generation-list-show-removed-packages)
(guix-generation-list-diff, guix-generation-list-diff-manifests)
(guix-generation-list-ediff, guix-generation-list-ediff-manifests)
(guix-generation-list-diff-packages)
(guix-generation-list-ediff-packages)
(guix-generation-list-mark-delete, guix-generation-list-execute): Move
to "guix-ui-generation.el".
* emacs/guix.el: Remove.
(guix, guix-faces, guix-edit): Move to "guix-base.el".
(guix-list-single-package, guix-search-params, guix-search-history)
(guix-get-show-packages, guix-search-by-name, guix-search-by-regexp)
(guix-installed-packages, guix-obsolete-packages)
(guix-all-available-packages, guix-newest-available-packages): Move
to "guix-ui-package.el".
(guix-get-show-generations, guix-generations, guix-last-generations)
(guix-generations-by-time): Move to "guix-ui-generation.el".
* emacs.am (ELFILES): Remove "guix.el". Add "guix-ui-package.el" and
"guix-ui-generation.el".
* doc/emacs.texi (Emacs Appearance): Adjust accordingly.
Diffstat (limited to 'emacs')
| -rw-r--r-- | emacs/guix-base.el | 293 | ||||
| -rw-r--r-- | emacs/guix-info.el | 455 | ||||
| -rw-r--r-- | emacs/guix-list.el | 449 | ||||
| -rw-r--r-- | emacs/guix-ui-generation.el | 439 | ||||
| -rw-r--r-- | emacs/guix-ui-package.el | 958 | ||||
| -rw-r--r-- | emacs/guix.el | 210 |
6 files changed, 1424 insertions, 1380 deletions
diff --git a/emacs/guix-base.el b/emacs/guix-base.el index ab8acdfb31..dae658ebfa 100644 --- a/emacs/guix-base.el +++ b/emacs/guix-base.el @@ -25,50 +25,29 @@ ;;; Code: (require 'cl-lib) -(require 'guix-profiles) (require 'guix-backend) -(require 'guix-entry) (require 'guix-guile) +(require 'guix-read) (require 'guix-utils) (require 'guix-ui) - -;;; Parameters of the entries +(defgroup guix nil + "Settings for Guix package manager and friends." + :prefix "guix-" + :group 'external) + +(defgroup guix-faces nil + "Guix faces." + :group 'guix + :group 'faces) (defun guix-package-name-specification (name version &optional output) "Return Guix package specification by its NAME, VERSION and OUTPUT." (concat name "-" version (when output (concat ":" output)))) -(defun guix-package-entry->name-specification (entry &optional output) - "Return name specification of the package ENTRY and OUTPUT." - (guix-package-name-specification - (guix-entry-value entry 'name) - (guix-entry-value entry 'version) - (or output (guix-entry-value entry 'output)))) - -(defun guix-package-entries->name-specifications (entries) - "Return name specifications by the package or output ENTRIES." - (cl-remove-duplicates (mapcar #'guix-package-entry->name-specification - entries) - :test #'string=)) - -(defun guix-package-installed-outputs (entry) - "Return list of installed outputs for the package ENTRY." - (mapcar (lambda (installed-entry) - (guix-entry-value installed-entry 'output)) - (guix-entry-value entry 'installed))) - -(defun guix-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 +;;; Location of packages, profiles and manifests (defvar guix-directory nil "Default Guix directory. @@ -108,56 +87,6 @@ For the meaning of location, see `guix-find-location'." (guix-eval-read (guix-make-guile-expression 'package-location-string id-or-name))) - -;;; Getting and displaying info about packages and generations - -(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) - -(defcustom guix-package-info-type 'package - "Define how to display packages in an info buffer. -May be a symbol `package' or `output' (if `output', display each -output separately; if `package', display outputs inside a package -information)." - :type '(choice (const :tag "Display packages" package) - (const :tag "Display outputs" output)) - :group 'guix) - - -;;; Generations - -(defcustom guix-generation-packages-buffer-name-function - #'guix-generation-packages-buffer-name-default - "Function used to define name of a buffer with generation packages. -This function is called with 2 arguments: PROFILE (string) and -GENERATION (number)." - :type '(choice (function-item guix-generation-packages-buffer-name-default) - (function-item guix-generation-packages-buffer-name-long) - (function :tag "Other function")) - :group 'guix) - -(defcustom guix-generation-packages-update-buffer t - "If non-nil, always update list of packages during comparing generations. -If nil, generation packages are received only once. So when you -compare generation 1 and generation 2, the packages for both -generations will be received. Then if you compare generation 1 -and generation 3, only the packages for generation 3 will be -received. Thus if you use comparing of different generations a -lot, you may set this variable to nil to improve the -performance." - :type 'boolean - :group 'guix) - -(defvar guix-output-name-width 30 - "Width of an output name \"column\". -This variable is used in auxiliary buffers for comparing generations.") - (defun guix-generation-file (profile generation) "Return the file name of a PROFILE's GENERATION." (format "%s-%s-link" profile generation)) @@ -171,75 +100,14 @@ this generation." (guix-generation-file profile generation) profile))) -(defun guix-generation-packages (profile generation) - "Return a list of sorted packages installed in PROFILE's GENERATION. -Each element of the list is a list of the package specification and its path." - (let ((names+paths (guix-eval-read - (guix-make-guile-expression - 'generation-package-specifications+paths - profile generation)))) - (sort names+paths - (lambda (a b) - (string< (car a) (car b)))))) - -(defun guix-generation-packages-buffer-name-default (profile generation) - "Return name of a buffer for displaying GENERATION's package outputs. -Use base name of PROFILE path." - (let ((profile-name (file-name-base (directory-file-name profile)))) - (format "*Guix %s: generation %s*" - profile-name generation))) - -(defun guix-generation-packages-buffer-name-long (profile generation) - "Return name of a buffer for displaying GENERATION's package outputs. -Use the full PROFILE path." - (format "*Guix generation %s (%s)*" - generation profile)) - -(defun guix-generation-packages-buffer-name (profile generation) - "Return name of a buffer for displaying GENERATION's package outputs." - (let ((fun (if (functionp guix-generation-packages-buffer-name-function) - guix-generation-packages-buffer-name-function - #'guix-generation-packages-buffer-name-default))) - (funcall fun profile generation))) - -(defun guix-generation-insert-package (name path) - "Insert package output NAME and PATH at point." - (insert name) - (indent-to guix-output-name-width 2) - (insert path "\n")) - -(defun guix-generation-insert-packages (buffer profile generation) - "Insert package outputs installed in PROFILE's GENERATION in BUFFER." - (with-current-buffer buffer - (setq buffer-read-only nil - indent-tabs-mode nil) - (erase-buffer) - (mapc (lambda (name+path) - (guix-generation-insert-package - (car name+path) (cadr name+path))) - (guix-generation-packages profile generation)))) - -(defun guix-generation-packages-buffer (profile generation) - "Return buffer with package outputs installed in PROFILE's GENERATION. -Create the buffer if needed." - (let ((buf-name (guix-generation-packages-buffer-name - profile generation))) - (or (and (null guix-generation-packages-update-buffer) - (get-buffer buf-name)) - (let ((buf (get-buffer-create buf-name))) - (guix-generation-insert-packages buf profile generation) - buf)))) - -(defun guix-profile-generation-manifest-file (generation) - "Return the file name of a GENERATION's manifest. -GENERATION is a generation number of the current profile." - (guix-manifest-file (guix-ui-current-profile) generation)) - -(defun guix-profile-generation-packages-buffer (generation) - "Insert GENERATION's package outputs in a buffer and return it. -GENERATION is a generation number of the current profile." - (guix-generation-packages-buffer (guix-ui-current-profile) - generation)) +;;;###autoload +(defun guix-edit (id-or-name) + "Edit (go to location of) package with ID-OR-NAME." + (interactive (list (guix-read-package-name))) + (let ((loc (guix-package-location id-or-name))) + (if loc + (guix-find-location loc) + (message "Couldn't find package location.")))) ;;; Actions on packages and generations @@ -313,101 +181,6 @@ VARIABLE is a name of an option variable.") guix-operation-option-true-string guix-operation-option-false-string)) -(defun guix-process-package-actions (profile actions - &optional operation-buffer) - "Process package ACTIONS on PROFILE. -Each action is a list of the form: - - (ACTION-TYPE PACKAGE-SPEC ...) - -ACTION-TYPE is one of the following symbols: `install', -`upgrade', `remove'/`delete'. -PACKAGE-SPEC should have the following form: (ID [OUTPUT] ...)." - (let (install upgrade remove) - (mapc (lambda (action) - (let ((action-type (car action)) - (specs (cdr action))) - (cl-case action-type - (install (setq install (append install specs))) - (upgrade (setq upgrade (append upgrade specs))) - ((remove delete) (setq remove (append remove specs)))))) - actions) - (when (guix-continue-package-operation-p - profile - :install install :upgrade upgrade :remove remove) - (guix-eval-in-repl - (guix-make-guile-expression - 'process-package-actions profile - :install install :upgrade upgrade :remove remove - :use-substitutes? (or guix-use-substitutes 'f) - :dry-run? (or guix-dry-run 'f)) - (and (not guix-dry-run) operation-buffer))))) - -(cl-defun guix-continue-package-operation-p (profile - &key install upgrade remove) - "Return non-nil if a package operation should be continued. -Ask a user if needed (see `guix-operation-confirm'). -INSTALL, UPGRADE, REMOVE are 'package action specifications'. -See `guix-process-package-actions' for details." - (or (null guix-operation-confirm) - (let* ((entries (guix-ui-get-entries - profile 'package 'id - (append (mapcar #'car install) - (mapcar #'car upgrade) - (mapcar #'car remove)) - '(id name version location))) - (install-strings (guix-get-package-strings install entries)) - (upgrade-strings (guix-get-package-strings upgrade entries)) - (remove-strings (guix-get-package-strings remove entries))) - (if (or install-strings upgrade-strings remove-strings) - (let ((buf (get-buffer-create guix-temp-buffer-name))) - (with-current-buffer buf - (setq-local cursor-type nil) - (setq buffer-read-only nil) - (erase-buffer) - (insert "Profile: " profile "\n\n") - (guix-insert-package-strings install-strings "install") - (guix-insert-package-strings upgrade-strings "upgrade") - (guix-insert-package-strings remove-strings "remove") - (let ((win (temp-buffer-window-show - buf - '((display-buffer-reuse-window - display-buffer-at-bottom) - (window-height . fit-window-to-buffer))))) - (prog1 (guix-operation-prompt) - (quit-window nil win))))) - (message "Nothing to be done. If the REPL was restarted, information is not up-to-date.") - nil)))) - -(defun guix-get-package-strings (specs entries) - "Return short package descriptions for performing package actions. -See `guix-process-package-actions' for the meaning of SPECS. -ENTRIES is a list of package entries to get info about packages." - (delq nil - (mapcar - (lambda (spec) - (let* ((id (car spec)) - (outputs (cdr spec)) - (entry (guix-entry-by-id id entries))) - (when entry - (let ((location (guix-entry-value entry 'location))) - (concat (guix-package-entry->name-specification entry) - (when outputs - (concat ":" - (guix-concat-strings outputs ","))) - (when location - (concat "\t(" location ")"))))))) - specs))) - -(defun guix-insert-package-strings (strings action) - "Insert information STRINGS at point for performing package ACTION." - (when strings - (insert "Package(s) to " (propertize action 'face 'bold) ":\n") - (mapc (lambda (str) - (insert " " str "\n")) - strings) - (insert "\n"))) - (defun guix-operation-prompt (&optional prompt) "Prompt a user for continuing the current operation. Return non-nil, if the operation should be continued; nil otherwise. @@ -462,34 +235,6 @@ Ask a user with PROMPT for continuing an operation." guix-operation-option-separator))) (force-mode-line-update)) -(defun guix-delete-generations (profile generations - &optional operation-buffer) - "Delete GENERATIONS from PROFILE. -Each element from GENERATIONS is a generation number." - (when (or (not guix-operation-confirm) - (y-or-n-p - (let ((count (length generations))) - (if (> count 1) - (format "Delete %d generations from profile '%s'? " - count profile) - (format "Delete generation %d from profile '%s'? " - (car generations) profile))))) - (guix-eval-in-repl - (guix-make-guile-expression - 'delete-generations* profile generations) - operation-buffer))) - -(defun guix-switch-to-generation (profile generation - &optional operation-buffer) - "Switch PROFILE to GENERATION." - (when (or (not guix-operation-confirm) - (y-or-n-p (format "Switch profile '%s' to generation %d? " - profile generation))) - (guix-eval-in-repl - (guix-make-guile-expression - 'switch-to-generation* profile generation) - operation-buffer))) - (defun guix-package-source-path (package-id) "Return a store file path to a source of a package PACKAGE-ID." (message "Calculating the source derivation ...") diff --git a/emacs/guix-info.el b/emacs/guix-info.el index 9c63892d06..5219ac5507 100644 --- a/emacs/guix-info.el +++ b/emacs/guix-info.el @@ -1,4 +1,4 @@ -;;; guix-info.el --- Info buffers for displaying entries -*- lexical-binding: t -*- +;;; guix-info.el --- 'Info' buffer interface for displaying data -*- lexical-binding: t -*- ;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com> ;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org> @@ -20,15 +20,14 @@ ;;; Commentary: -;; This file provides a help-like buffer for displaying information -;; about Guix packages and generations. +;; This file provides 'info' (help-like) buffer interface for displaying +;; an arbitrary data. ;;; Code: -(require 'guix-base) +(require 'guix-buffer) (require 'guix-entry) (require 'guix-utils) -(require 'guix-ui) (defgroup guix-info nil "General settings for info buffers." @@ -358,24 +357,6 @@ BUTTON-OR-FACE is a button type)." 'action (lambda (btn) (browse-url (button-label btn)))) -(define-button-type 'guix-package-location - :supertype 'guix - 'face 'guix-package-info-location - 'help-echo "Find location of this package" - 'action (lambda (btn) - (guix-find-location (button-label btn)))) - -(define-button-type 'guix-package-name - :supertype 'guix - 'face 'guix-package-info-name-button - 'help-echo "Describe this package" - 'action (lambda (btn) - (guix-buffer-get-display-entries-current - 'info guix-package-info-type - (list (guix-ui-current-profile) - 'name (button-label btn)) - 'add))) - (defun guix-info-button-copy-label (&optional pos) "Copy a label of the button at POS into kill ring. If POS is nil, use the current point position." @@ -496,434 +477,6 @@ Print '%s' ENTRIES in the current 'info' buffer." ,@%foreign-args)))))))) -;;; Displaying packages - -(guix-ui-info-define-interface package - :buffer-name "*Guix Package Info*" - :format '(guix-package-info-insert-heading - ignore - (synopsis ignore (simple guix-package-info-synopsis)) - ignore - (description ignore (simple guix-package-info-description)) - ignore - (outputs simple guix-package-info-insert-outputs) - (source simple guix-package-info-insert-source) - (location format (format guix-package-location)) - (home-url format (format guix-url)) - (license format (format guix-package-info-license)) - (inputs format (format guix-package-input)) - (native-inputs format (format guix-package-native-input)) - (propagated-inputs format - (format guix-package-propagated-input))) - :titles '((home-url . "Home page")) - :required '(id name version installed non-unique)) - -(guix-info-define-interface installed-output - :format '((path simple (indent guix-file)) - (dependencies simple (indent guix-file))) - :titles '((path . "Store directory")) - :reduced? t) - -(defface guix-package-info-heading - '((t :inherit guix-info-heading)) - "Face for package name and version headings." - :group 'guix-package-info-faces) - -(defface guix-package-info-name - '((t :inherit font-lock-keyword-face)) - "Face used for a name of a package." - :group 'guix-package-info-faces) - -(defface guix-package-info-name-button - '((t :inherit button)) - "Face used for a full name that can be used to describe a package." - :group 'guix-package-info-faces) - -(defface guix-package-info-version - '((t :inherit font-lock-builtin-face)) - "Face used for a version of a package." - :group 'guix-package-info-faces) - -(defface guix-package-info-synopsis - '((((type tty pc) (class color)) :weight bold) - (t :height 1.1 :weight bold :inherit variable-pitch)) - "Face used for a synopsis of a package." - :group 'guix-package-info-faces) - -(defface guix-package-info-description - '((t)) - "Face used for a description of a package." - :group 'guix-package-info-faces) - -(defface guix-package-info-license - '((t :inherit font-lock-string-face)) - "Face used for a license of a package." - :group 'guix-package-info-faces) - -(defface guix-package-info-location - '((t :inherit link)) - "Face used for a location of a package." - :group 'guix-package-info-faces) - -(defface guix-package-info-installed-outputs - '((default :weight bold) - (((class color) (min-colors 88) (background light)) - :foreground "ForestGreen") - (((class color) (min-colors 88) (background dark)) - :foreground "PaleGreen") - (((class color) (min-colors 8)) - :foreground "green") - (t :underline t)) - "Face used for installed outputs of a package." - :group 'guix-package-info-faces) - -(defface guix-package-info-uninstalled-outputs - '((t :weight bold)) - "Face used for uninstalled outputs of a package." - :group 'guix-package-info-faces) - -(defface guix-package-info-obsolete - '((t :inherit error)) - "Face used if a package is obsolete." - :group 'guix-package-info-faces) - -(defun guix-package-info-insert-heading (entry) - "Insert package ENTRY heading (name specification) at point." - (guix-insert-button - (guix-package-entry->name-specification entry) - 'guix-package-name - 'face 'guix-package-info-heading)) - -(defmacro guix-package-info-define-insert-inputs (&optional type) - "Define a face and a function for inserting package inputs. -TYPE is a type of inputs. -Function name is `guix-package-info-insert-TYPE-inputs'. -Face name is `guix-package-info-TYPE-inputs'." - (let* ((type-str (symbol-name type)) - (type-name (and type (concat type-str "-"))) - (type-desc (and type (concat type-str " "))) - (face (intern (concat "guix-package-info-" type-name "inputs"))) - (btn (intern (concat "guix-package-" type-name "input")))) - `(progn - (defface ,face - '((t :inherit guix-package-info-name-button)) - ,(concat "Face used for " type-desc "inputs of a package.") - :group 'guix-package-info-faces) - - (define-button-type ',btn - :supertype 'guix-package-name - 'face ',face)))) - -(guix-package-info-define-insert-inputs) -(guix-package-info-define-insert-inputs native) -(guix-package-info-define-insert-inputs propagated) - - -;;; Inserting outputs and installed parameters - -(defvar guix-package-info-output-format "%-10s" - "String used to format output names of the packages. -It should be a '%s'-sequence. After inserting an output name -formatted with this string, an action button is inserted.") - -(defvar guix-package-info-obsolete-string "(This package is obsolete)" - "String used if a package is obsolete.") - -(defun guix-package-info-insert-outputs (outputs entry) - "Insert OUTPUTS from package ENTRY at point." - (and (guix-entry-value entry 'obsolete) - (guix-package-info-insert-obsolete-text)) - (and (guix-entry-value entry 'non-unique) - (guix-entry-value entry 'installed) - (guix-package-info-insert-non-unique-text - (guix-package-entry->name-specification entry))) - (insert "\n") - (mapc (lambda (output) - (guix-package-info-insert-output output entry)) - outputs)) - -(defun guix-package-info-insert-obsolete-text () - "Insert a message about obsolete package at point." - (guix-info-insert-indent) - (guix-format-insert guix-package-info-obsolete-string - 'guix-package-info-obsolete)) - -(defun guix-package-info-insert-non-unique-text (full-name) - "Insert a message about non-unique package with FULL-NAME at point." - (insert "\n") - (guix-info-insert-indent) - (insert "Installed outputs are displayed for a non-unique ") - (guix-insert-button full-name 'guix-package-name) - (insert " package.")) - -(defun guix-package-info-insert-output (output entry) - "Insert OUTPUT at point. -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-entry-value entry 'installed)) - (obsolete (guix-entry-value entry 'obsolete)) - (installed-entry (cl-find-if - (lambda (entry) - (string= (guix-entry-value entry 'output) - output)) - installed)) - (action-type (if installed-entry 'delete 'install))) - (guix-info-insert-indent) - (guix-format-insert output - (if installed-entry - 'guix-package-info-installed-outputs - 'guix-package-info-uninstalled-outputs) - guix-package-info-output-format) - (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)) - (insert "\n") - (when installed-entry - (guix-info-insert-entry installed-entry 'installed-output 2)))) - -(defun guix-package-info-insert-action-button (type entry output) - "Insert button to process an action on a package OUTPUT at point. -TYPE is one of the following symbols: `install', `delete', `upgrade'. -ENTRY is an alist with package info." - (let ((type-str (capitalize (symbol-name type))) - (full-name (guix-package-entry->name-specification entry output))) - (guix-info-insert-action-button - type-str - (lambda (btn) - (guix-process-package-actions - (guix-ui-current-profile) - `((,(button-get btn 'action-type) (,(button-get btn 'id) - ,(button-get btn 'output)))) - (current-buffer))) - (concat type-str " '" full-name "'") - 'action-type type - 'id (or (guix-entry-value entry 'package-id) - (guix-entry-id entry)) - 'output output))) - - -;;; Inserting a source - -(defface guix-package-info-source - '((t :inherit link :underline nil)) - "Face used for a source URL of a package." - :group 'guix-package-info-faces) - -(defcustom guix-package-info-auto-find-source nil - "If non-nil, find a source file after pressing a \"Show\" button. -If nil, just display the source file path without finding." - :type 'boolean - :group 'guix-package-info) - -(defcustom guix-package-info-auto-download-source t - "If nil, do not automatically download a source file if it doesn't exist. -After pressing a \"Show\" button, a derivation of the package -source is calculated and a store file path is displayed. If this -variable is non-nil and the source file does not exist in the -store, it will be automatically downloaded (with a possible -prompt depending on `guix-operation-confirm' variable)." - :type 'boolean - :group 'guix-package-info) - -(defvar guix-package-info-download-buffer nil - "Buffer from which a current download operation was performed.") - -(define-button-type 'guix-package-source - :supertype 'guix - 'face 'guix-package-info-source - 'help-echo "" - 'action (lambda (_) - ;; As a source may not be a real URL (e.g., "mirror://..."), - ;; no action is bound to a source button. - (message "Yes, this is the source URL. What did you expect?"))) - -(defun guix-package-info-show-source (entry-id package-id) - "Show file name of a package source in the current info buffer. -Find the file if needed (see `guix-package-info-auto-find-source'). -ENTRY-ID is an ID of the current entry (package or output). -PACKAGE-ID is an ID of the package which source to show." - (let* ((entries (guix-buffer-current-entries)) - (entry (guix-entry-by-id entry-id entries)) - (file (guix-package-source-path package-id))) - (or file - (error "Couldn't define file name of the package source")) - (let* ((new-entry (cons (cons 'source-file file) - entry)) - (new-entries (guix-replace-entry entry-id new-entry entries))) - (setf (guix-buffer-item-entries guix-buffer-item) - new-entries) - (guix-buffer-redisplay-goto-button) - (if (file-exists-p file) - (if guix-package-info-auto-find-source - (guix-find-file file) - (message "The source store path is displayed.")) - (if guix-package-info-auto-download-source - (guix-package-info-download-source package-id) - (message "The source does not exist in the store.")))))) - -(defun guix-package-info-download-source (package-id) - "Download a source of the package PACKAGE-ID." - (setq guix-package-info-download-buffer (current-buffer)) - (guix-package-source-build-derivation - package-id - "The source does not exist in the store. Download it?")) - -(defun guix-package-info-insert-source (source entry) - "Insert SOURCE from package ENTRY at point. -SOURCE is a list of URLs." - (if (null source) - (guix-format-insert nil) - (let* ((source-file (guix-entry-value entry 'source-file)) - (entry-id (guix-entry-id entry)) - (package-id (or (guix-entry-value entry 'package-id) - entry-id))) - (if (null source-file) - (guix-info-insert-action-button - "Show" - (lambda (btn) - (guix-package-info-show-source (button-get btn 'entry-id) - (button-get btn 'package-id))) - "Show the source store directory of the current package" - 'entry-id entry-id - 'package-id package-id) - (unless (file-exists-p source-file) - (guix-info-insert-action-button - "Download" - (lambda (btn) - (guix-package-info-download-source - (button-get btn 'package-id))) - "Download the source into the store" - 'package-id package-id)) - (guix-info-insert-value-indent source-file 'guix-file)) - (guix-info-insert-value-indent source 'guix-package-source)))) - -(defun guix-package-info-redisplay-after-download () - "Redisplay an 'info' buffer after downloading the package source. -This function is used to hide a \"Download\" button if needed." - (when (buffer-live-p guix-package-info-download-buffer) - (with-current-buffer guix-package-info-download-buffer - (guix-buffer-redisplay-goto-button)) - (setq guix-package-info-download-buffer nil))) - -(add-hook 'guix-after-source-download-hook - 'guix-package-info-redisplay-after-download) - - -;;; Displaying outputs - -(guix-ui-info-define-interface output - :buffer-name "*Guix Package Info*" - :format '((name format (format guix-package-info-name)) - (version format guix-output-info-insert-version) - (output format guix-output-info-insert-output) - (synopsis simple (indent guix-package-info-synopsis)) - (source simple guix-package-info-insert-source) - (path simple (indent guix-file)) - (dependencies simple (indent guix-file)) - (location format (format guix-package-location)) - (home-url format (format guix-url)) - (license format (format guix-package-info-license)) - (inputs format (format guix-package-input)) - (native-inputs format (format guix-package-native-input)) - (propagated-inputs format - (format guix-package-propagated-input)) - (description simple (indent guix-package-info-description))) - :titles guix-package-info-titles - :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-value-format version - 'guix-package-info-version) - (and (guix-entry-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-entry-value entry 'installed)) - (obsolete (guix-entry-value entry 'obsolete)) - (action-type (if installed 'delete 'install))) - (guix-info-insert-value-format - 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 - -(guix-ui-info-define-interface generation - :buffer-name "*Guix Generation Info*" - :format '((number format guix-generation-info-insert-number) - (prev-number format (format)) - (current format guix-generation-info-insert-current) - (path simple (indent guix-file)) - (time format (time))) - :titles '((path . "File name") - (prev-number . "Previous number"))) - -(defface guix-generation-info-number - '((t :inherit font-lock-keyword-face)) - "Face used for a number of a generation." - :group 'guix-generation-info-faces) - -(defface guix-generation-info-current - '((t :inherit guix-package-info-installed-outputs)) - "Face used if a generation is the current one." - :group 'guix-generation-info-faces) - -(defface guix-generation-info-not-current - '((t nil)) - "Face used if a generation is not the current one." - :group 'guix-generation-info-faces) - -(defun guix-generation-info-insert-number (number &optional _) - "Insert generation NUMBER and action buttons." - (guix-info-insert-value-format number 'guix-generation-info-number) - (guix-info-insert-indent) - (guix-info-insert-action-button - "Packages" - (lambda (btn) - (guix-buffer-get-display-entries - 'list guix-package-list-type - (list (guix-ui-current-profile) - 'generation (button-get btn 'number)) - 'add)) - "Show installed packages for this generation" - 'number number) - (guix-info-insert-indent) - (guix-info-insert-action-button - "Delete" - (lambda (btn) - (guix-delete-generations (guix-ui-current-profile) - (list (button-get btn 'number)) - (current-buffer))) - "Delete this generation" - 'number number)) - -(defun guix-generation-info-insert-current (val entry) - "Insert boolean value VAL showing whether this generation is current." - (if val - (guix-info-insert-value-format "Yes" 'guix-generation-info-current) - (guix-info-insert-value-format "No" 'guix-generation-info-not-current) - (guix-info-insert-indent) - (guix-info-insert-action-button - "Switch" - (lambda (btn) - (guix-switch-to-generation (guix-ui-current-profile) - (button-get btn 'number) - (current-buffer))) - "Switch to this generation (make it the current one)" - 'number (guix-entry-value entry 'number)))) - - (defvar guix-info-font-lock-keywords (eval-when-compile `((,(rx "(" (group "guix-info-define-interface") diff --git a/emacs/guix-list.el b/emacs/guix-list.el index f5c50389ed..719642ad07 100644 --- a/emacs/guix-list.el +++ b/emacs/guix-list.el @@ -1,4 +1,4 @@ -;;; guix-list.el --- List buffers for displaying entries -*- lexical-binding: t -*- +;;; guix-list.el --- 'List' buffer interface for displaying data -*- lexical-binding: t -*- ;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com> @@ -19,18 +19,17 @@ ;;; Commentary: -;; This file provides a list-like buffer for displaying information -;; about Guix packages and generations. +;; This file provides 'list' buffer interface for displaying an arbitrary +;; data. ;;; Code: (require 'cl-lib) (require 'tabulated-list) +(require 'guix-buffer) (require 'guix-info) -(require 'guix-base) (require 'guix-entry) (require 'guix-utils) -(require 'guix-ui) (defgroup guix-list nil "General settings for list buffers." @@ -534,446 +533,6 @@ Set up the current 'list' buffer for displaying '%s' entries." ,@%foreign-args)))))))) -;;; Displaying packages - -(guix-ui-list-define-interface package - :buffer-name "*Guix Package List*" - :format '((name guix-package-list-get-name 20 t) - (version nil 10 nil) - (outputs nil 13 t) - (installed guix-package-list-get-installed-outputs 13 t) - (synopsis guix-list-get-one-line 30 nil)) - :sort-key '(name) - :marks '((install . ?I) - (upgrade . ?U) - (delete . ?D))) - -(defface guix-package-list-installed - '((t :inherit guix-package-info-installed-outputs)) - "Face used if there are installed outputs for the current package." - :group 'guix-package-list-faces) - -(defface guix-package-list-obsolete - '((t :inherit guix-package-info-obsolete)) - "Face used if a package is obsolete." - :group 'guix-package-list-faces) - -(defcustom guix-package-list-generation-marking-enabled nil - "If non-nil, allow putting marks in a list with 'generation packages'. - -By default this is disabled, because it may be confusing. For -example a package is installed in some generation, so a user can -mark it for deletion in the list of packages from this -generation, but the package may not be installed in the latest -generation, so actually it cannot be deleted. - -If you managed to understand the explanation above or if you -really know what you do or if you just don't care, you can set -this variable to t. It should not do much harm anyway (most -likely)." - :type 'boolean - :group 'guix-package-list) - -(let ((map guix-package-list-mode-map)) - (define-key map (kbd "e") 'guix-package-list-edit) - (define-key map (kbd "x") 'guix-package-list-execute) - (define-key map (kbd "i") 'guix-package-list-mark-install) - (define-key map (kbd "d") 'guix-package-list-mark-delete) - (define-key map (kbd "U") 'guix-package-list-mark-upgrade) - (define-key map (kbd "^") 'guix-package-list-mark-upgrades)) - -(defun guix-package-list-get-name (name entry) - "Return NAME of the package ENTRY. -Colorize it with `guix-package-list-installed' or -`guix-package-list-obsolete' if needed." - (guix-get-string name - (cond ((guix-entry-value entry 'obsolete) - 'guix-package-list-obsolete) - ((guix-entry-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-entry-value entry 'output)) - installed))) - -(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) - (or (derived-mode-p 'guix-package-list-mode) - (derived-mode-p 'guix-output-list-mode)) - (eq (guix-ui-current-search-type) 'generation)) - (error "Action marks are disabled for lists of 'generation packages'"))) - -(defun guix-package-list-mark-outputs (mark default - &optional prompt available) - "Mark the current package with MARK and move to the next line. -If PROMPT is non-nil, use it to ask a user for outputs from -AVAILABLE list, otherwise mark all DEFAULT outputs." - (let ((outputs (if prompt - (guix-completing-read-multiple - prompt available nil t) - default))) - (apply #'guix-list--mark mark t outputs))) - -(defun guix-package-list-mark-install (&optional arg) - "Mark the current package for installation and move to the next line. -With ARG, prompt for the outputs to install (several outputs may -be separated with \",\")." - (interactive "P") - (guix-package-list-marking-check) - (let* ((entry (guix-list-current-entry)) - (all (guix-entry-value entry 'outputs)) - (installed (guix-package-installed-outputs entry)) - (available (cl-set-difference all installed :test #'string=))) - (or available - (user-error "This package is already installed")) - (guix-package-list-mark-outputs - 'install '("out") - (and arg "Output(s) to install: ") - available))) - -(defun guix-package-list-mark-delete (&optional arg) - "Mark the current package for deletion and move to the next line. -With ARG, prompt for the outputs to delete (several outputs may -be separated with \",\")." - (interactive "P") - (guix-package-list-marking-check) - (let* ((entry (guix-list-current-entry)) - (installed (guix-package-installed-outputs entry))) - (or installed - (user-error "This package is not installed")) - (guix-package-list-mark-outputs - 'delete installed - (and arg "Output(s) to delete: ") - installed))) - -(defun guix-package-list-mark-upgrade (&optional arg) - "Mark the current package for upgrading and move to the next line. -With ARG, prompt for the outputs to upgrade (several outputs may -be separated with \",\")." - (interactive "P") - (guix-package-list-marking-check) - (let* ((entry (guix-list-current-entry)) - (installed (guix-package-installed-outputs entry))) - (or installed - (user-error "This package is not installed")) - (when (or (guix-entry-value entry 'obsolete) - (y-or-n-p "This package is not obsolete. Try to upgrade it anyway? ")) - (guix-package-list-mark-outputs - 'upgrade installed - (and arg "Output(s) to upgrade: ") - installed)))) - -(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) - (guix-entry-value entry 'obsolete)) - (guix-buffer-current-entries)))) - (guix-list-for-each-line - (lambda () - (let* ((id (guix-list-current-id)) - (entry (cl-find-if - (lambda (entry) - (equal id (guix-entry-id entry))) - obsolete))) - (when entry - (funcall fun entry))))))) - -(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-package-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 fun '(install delete upgrade))))) - (if actions - (guix-process-package-actions (guix-ui-current-profile) - actions (current-buffer)) - (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. -The specification is suitable for `guix-process-package-actions'." - (let ((specs (guix-list-get-marked-args action-type))) - (and specs (cons action-type specs)))) - -(defun guix-package-list-edit () - "Go to the location of the current package." - (interactive) - (guix-edit (guix-list-current-id))) - - -;;; Displaying outputs - -(guix-ui-list-define-interface output - :buffer-name "*Guix Package List*" - :describe-function 'guix-output-list-describe - :format '((name guix-package-list-get-name 20 t) - (version nil 10 nil) - (output nil 9 t) - (installed nil 12 t) - (synopsis guix-list-get-one-line 30 nil)) - :required '(id package-id) - :sort-key '(name) - :marks '((install . ?I) - (upgrade . ?U) - (delete . ?D))) - -(let ((map guix-output-list-mode-map)) - (define-key map (kbd "e") 'guix-output-list-edit) - (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-entry-value 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-entry-value 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-entry-value entry 'installed))) - (or installed - (user-error "This output is not installed")) - (when (or (guix-entry-value 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-package-id-and-output-by-output-id - ids))))) - -(defun guix-output-list-describe (ids) - "Describe outputs with IDS (list of output identifiers). -See `guix-package-info-type'." - (if (eq guix-package-info-type 'output) - (guix-buffer-get-display-entries - 'info 'output - (cl-list* (guix-ui-current-profile) 'id ids) - 'add) - (let ((pids (mapcar (lambda (oid) - (car (guix-package-id-and-output-by-output-id - oid))) - ids))) - (guix-buffer-get-display-entries - 'info 'package - (cl-list* (guix-ui-current-profile) - 'id (cl-remove-duplicates pids)) - 'add)))) - -(defun guix-output-list-edit () - "Go to the location of the current package." - (interactive) - (guix-edit (guix-entry-value (guix-list-current-entry) - 'package-id))) - - -;;; Displaying generations - -(guix-ui-list-define-interface generation - :buffer-name "*Guix Generation List*" - :format '((number nil 5 guix-list-sort-numerically-0 :right-align t) - (current guix-generation-list-get-current 10 t) - (time guix-list-get-time 20 t) - (path guix-list-get-file-path 30 t)) - :titles '((number . "N.")) - :sort-key '(number . t) - :marks '((delete . ?D))) - -(let ((map guix-generation-list-mode-map)) - (define-key map (kbd "RET") 'guix-generation-list-show-packages) - (define-key map (kbd "+") 'guix-generation-list-show-added-packages) - (define-key map (kbd "-") 'guix-generation-list-show-removed-packages) - (define-key map (kbd "=") 'guix-generation-list-diff) - (define-key map (kbd "D") 'guix-generation-list-diff) - (define-key map (kbd "e") 'guix-generation-list-ediff) - (define-key map (kbd "x") 'guix-generation-list-execute) - (define-key map (kbd "s") 'guix-generation-list-switch) - (define-key map (kbd "d") 'guix-generation-list-mark-delete)) - -(defun guix-generation-list-get-current (val &optional _) - "Return string from VAL showing whether this generation is current. -VAL is a boolean value." - (if val "(current)" "")) - -(defun guix-generation-list-switch () - "Switch current profile to the generation at point." - (interactive) - (let* ((entry (guix-list-current-entry)) - (current (guix-entry-value entry 'current)) - (number (guix-entry-value entry 'number))) - (if current - (user-error "This generation is already the current one") - (guix-switch-to-generation (guix-ui-current-profile) - number (current-buffer))))) - -(defun guix-generation-list-show-packages () - "List installed packages for the generation at point." - (interactive) - (guix-get-show-packages - (guix-ui-current-profile) - 'generation (guix-list-current-id))) - -(defun guix-generation-list-generations-to-compare () - "Return a sorted list of 2 marked generations for comparing." - (let ((numbers (guix-list-get-marked-id-list 'general))) - (if (/= (length numbers) 2) - (user-error "2 generations should be marked for comparing") - (sort numbers #'<)))) - -(defun guix-generation-list-show-added-packages () - "List package outputs added to the latest marked generation. -If 2 generations are marked with \\[guix-list-mark], display -outputs installed in the latest marked generation that were not -installed in the other one." - (interactive) - (guix-buffer-get-display-entries - 'list 'output - (cl-list* (guix-ui-current-profile) - 'generation-diff - (reverse (guix-generation-list-generations-to-compare))) - 'add)) - -(defun guix-generation-list-show-removed-packages () - "List package outputs removed from the latest marked generation. -If 2 generations are marked with \\[guix-list-mark], display -outputs not installed in the latest marked generation that were -installed in the other one." - (interactive) - (guix-buffer-get-display-entries - 'list 'output - (cl-list* (guix-ui-current-profile) - 'generation-diff - (guix-generation-list-generations-to-compare)) - 'add)) - -(defun guix-generation-list-compare (diff-fun gen-fun) - "Run GEN-FUN on the 2 marked generations and run DIFF-FUN on the results." - (cl-multiple-value-bind (gen1 gen2) - (guix-generation-list-generations-to-compare) - (funcall diff-fun - (funcall gen-fun gen1) - (funcall gen-fun gen2)))) - -(defun guix-generation-list-ediff-manifests () - "Run Ediff on manifests of the 2 marked generations." - (interactive) - (guix-generation-list-compare - #'ediff-files - #'guix-profile-generation-manifest-file)) - -(defun guix-generation-list-diff-manifests () - "Run Diff on manifests of the 2 marked generations." - (interactive) - (guix-generation-list-compare - #'guix-diff - #'guix-profile-generation-manifest-file)) - -(defun guix-generation-list-ediff-packages () - "Run Ediff on package outputs installed in the 2 marked generations." - (interactive) - (guix-generation-list-compare - #'ediff-buffers - #'guix-profile-generation-packages-buffer)) - -(defun guix-generation-list-diff-packages () - "Run Diff on package outputs installed in the 2 marked generations." - (interactive) - (guix-generation-list-compare - #'guix-diff - #'guix-profile-generation-packages-buffer)) - -(defun guix-generation-list-ediff (arg) - "Run Ediff on package outputs installed in the 2 marked generations. -With ARG, run Ediff on manifests of the marked generations." - (interactive "P") - (if arg - (guix-generation-list-ediff-manifests) - (guix-generation-list-ediff-packages))) - -(defun guix-generation-list-diff (arg) - "Run Diff on package outputs installed in the 2 marked generations. -With ARG, run Diff on manifests of the marked generations." - (interactive "P") - (if arg - (guix-generation-list-diff-manifests) - (guix-generation-list-diff-packages))) - -(defun guix-generation-list-mark-delete (&optional arg) - "Mark the current generation for deletion and move to the next line. -With ARG, mark all generations for deletion." - (interactive "P") - (if arg - (guix-list-mark-all 'delete) - (guix-list--mark 'delete t))) - -(defun guix-generation-list-execute () - "Delete marked generations." - (interactive) - (let ((marked (guix-list-get-marked-id-list 'delete))) - (or marked - (user-error "No generations marked for deletion")) - (guix-delete-generations (guix-ui-current-profile) - marked (current-buffer)))) - - (defvar guix-list-font-lock-keywords (eval-when-compile `((,(rx "(" (group "guix-list-define-interface") diff --git a/emacs/guix-ui-generation.el b/emacs/guix-ui-generation.el new file mode 100644 index 0000000000..7d6762a444 --- /dev/null +++ b/emacs/guix-ui-generation.el @@ -0,0 +1,439 @@ +;;; guix-ui-generation.el --- Interface for displaying generations -*- lexical-binding: t -*- + +;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com> + +;; This file is part of GNU Guix. + +;; GNU Guix is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Guix is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This file provides an interface for displaying profile generations in +;; 'list' and 'info' buffers, and commands for working with them. + +;;; Code: + +(require 'cl-lib) +(require 'guix-buffer) +(require 'guix-list) +(require 'guix-info) +(require 'guix-ui) +(require 'guix-ui-package) +(require 'guix-base) +(require 'guix-backend) +(require 'guix-guile) +(require 'guix-entry) +(require 'guix-utils) + +(defgroup guix-generation nil + "Interface for displaying generations." + :group 'guix-ui) + +(defun guix-generation-get-display (profile search-type &rest search-values) + "Search for generations and show results. + +If PROFILE is nil, use `guix-current-profile'. + +See `guix-ui-get-entries' for the meaning of SEARCH-TYPE and +SEARCH-VALUES." + (let ((args (cl-list* (or profile guix-current-profile) + search-type search-values))) + (guix-buffer-get-display-entries + 'list 'generation args 'add))) + +(defun guix-delete-generations (profile generations + &optional operation-buffer) + "Delete GENERATIONS from PROFILE. +Each element from GENERATIONS is a generation number." + (when (or (not guix-operation-confirm) + (y-or-n-p + (let ((count (length generations))) + (if (> count 1) + (format "Delete %d generations from profile '%s'? " + count profile) + (format "Delete generation %d from profile '%s'? " + (car generations) profile))))) + (guix-eval-in-repl + (guix-make-guile-expression + 'delete-generations* profile generations) + operation-buffer))) + +(defun guix-switch-to-generation (profile generation + &optional operation-buffer) + "Switch PROFILE to GENERATION." + (when (or (not guix-operation-confirm) + (y-or-n-p (format "Switch profile '%s' to generation %d? " + profile generation))) + (guix-eval-in-repl + (guix-make-guile-expression + 'switch-to-generation* profile generation) + operation-buffer))) + + +;;; Generation 'info' + +(guix-ui-info-define-interface generation + :buffer-name "*Guix Generation Info*" + :format '((number format guix-generation-info-insert-number) + (prev-number format (format)) + (current format guix-generation-info-insert-current) + (path simple (indent guix-file)) + (time format (time))) + :titles '((path . "File name") + (prev-number . "Previous number"))) + +(defface guix-generation-info-number + '((t :inherit font-lock-keyword-face)) + "Face used for a number of a generation." + :group 'guix-generation-info-faces) + +(defface guix-generation-info-current + '((t :inherit guix-package-info-installed-outputs)) + "Face used if a generation is the current one." + :group 'guix-generation-info-faces) + +(defface guix-generation-info-not-current + '((t nil)) + "Face used if a generation is not the current one." + :group 'guix-generation-info-faces) + +(defun guix-generation-info-insert-number (number &optional _) + "Insert generation NUMBER and action buttons." + (guix-info-insert-value-format number 'guix-generation-info-number) + (guix-info-insert-indent) + (guix-info-insert-action-button + "Packages" + (lambda (btn) + (guix-buffer-get-display-entries + 'list guix-package-list-type + (list (guix-ui-current-profile) + 'generation (button-get btn 'number)) + 'add)) + "Show installed packages for this generation" + 'number number) + (guix-info-insert-indent) + (guix-info-insert-action-button + "Delete" + (lambda (btn) + (guix-delete-generations (guix-ui-current-profile) + (list (button-get btn 'number)) + (current-buffer))) + "Delete this generation" + 'number number)) + +(defun guix-generation-info-insert-current (val entry) + "Insert boolean value VAL showing whether this generation is current." + (if val + (guix-info-insert-value-format "Yes" 'guix-generation-info-current) + (guix-info-insert-value-format "No" 'guix-generation-info-not-current) + (guix-info-insert-indent) + (guix-info-insert-action-button + "Switch" + (lambda (btn) + (guix-switch-to-generation (guix-ui-current-profile) + (button-get btn 'number) + (current-buffer))) + "Switch to this generation (make it the current one)" + 'number (guix-entry-value entry 'number)))) + + +;;; Generation 'list' + +(guix-ui-list-define-interface generation + :buffer-name "*Guix Generation List*" + :format '((number nil 5 guix-list-sort-numerically-0 :right-align t) + (current guix-generation-list-get-current 10 t) + (time guix-list-get-time 20 t) + (path guix-list-get-file-path 30 t)) + :titles '((number . "N.")) + :sort-key '(number . t) + :marks '((delete . ?D))) + +(let ((map guix-generation-list-mode-map)) + (define-key map (kbd "RET") 'guix-generation-list-show-packages) + (define-key map (kbd "+") 'guix-generation-list-show-added-packages) + (define-key map (kbd "-") 'guix-generation-list-show-removed-packages) + (define-key map (kbd "=") 'guix-generation-list-diff) + (define-key map (kbd "D") 'guix-generation-list-diff) + (define-key map (kbd "e") 'guix-generation-list-ediff) + (define-key map (kbd "x") 'guix-generation-list-execute) + (define-key map (kbd "s") 'guix-generation-list-switch) + (define-key map (kbd "c") 'guix-generation-list-switch) + (define-key map (kbd "d") 'guix-generation-list-mark-delete)) + +(defun guix-generation-list-get-current (val &optional _) + "Return string from VAL showing whether this generation is current. +VAL is a boolean value." + (if val "(current)" "")) + +(defun guix-generation-list-switch () + "Switch current profile to the generation at point." + (interactive) + (let* ((entry (guix-list-current-entry)) + (current (guix-entry-value entry 'current)) + (number (guix-entry-value entry 'number))) + (if current + (user-error "This generation is already the current one") + (guix-switch-to-generation (guix-ui-current-profile) + number (current-buffer))))) + +(defun guix-generation-list-show-packages () + "List installed packages for the generation at point." + (interactive) + (guix-package-get-display + (guix-ui-current-profile) + 'generation (guix-list-current-id))) + +(defun guix-generation-list-generations-to-compare () + "Return a sorted list of 2 marked generations for comparing." + (let ((numbers (guix-list-get-marked-id-list 'general))) + (if (/= (length numbers) 2) + (user-error "2 generations should be marked for comparing") + (sort numbers #'<)))) + +(defun guix-generation-list-show-added-packages () + "List package outputs added to the latest marked generation. +If 2 generations are marked with \\[guix-list-mark], display +outputs installed in the latest marked generation that were not +installed in the other one." + (interactive) + (guix-buffer-get-display-entries + 'list 'output + (cl-list* (guix-ui-current-profile) + 'generation-diff + (reverse (guix-generation-list-generations-to-compare))) + 'add)) + +(defun guix-generation-list-show-removed-packages () + "List package outputs removed from the latest marked generation. +If 2 generations are marked with \\[guix-list-mark], display +outputs not installed in the latest marked generation that were +installed in the other one." + (interactive) + (guix-buffer-get-display-entries + 'list 'output + (cl-list* (guix-ui-current-profile) + 'generation-diff + (guix-generation-list-generations-to-compare)) + 'add)) + +(defun guix-generation-list-compare (diff-fun gen-fun) + "Run GEN-FUN on the 2 marked generations and run DIFF-FUN on the results." + (cl-multiple-value-bind (gen1 gen2) + (guix-generation-list-generations-to-compare) + (funcall diff-fun + (funcall gen-fun gen1) + (funcall gen-fun gen2)))) + +(defun guix-generation-list-ediff-manifests () + "Run Ediff on manifests of the 2 marked generations." + (interactive) + (guix-generation-list-compare + #'ediff-files + #'guix-profile-generation-manifest-file)) + +(defun guix-generation-list-diff-manifests () + "Run Diff on manifests of the 2 marked generations." + (interactive) + (guix-generation-list-compare + #'guix-diff + #'guix-profile-generation-manifest-file)) + +(defun guix-generation-list-ediff-packages () + "Run Ediff on package outputs installed in the 2 marked generations." + (interactive) + (guix-generation-list-compare + #'ediff-buffers + #'guix-profile-generation-packages-buffer)) + +(defun guix-generation-list-diff-packages () + "Run Diff on package outputs installed in the 2 marked generations." + (interactive) + (guix-generation-list-compare + #'guix-diff + #'guix-profile-generation-packages-buffer)) + +(defun guix-generation-list-ediff (arg) + "Run Ediff on package outputs installed in the 2 marked generations. +With ARG, run Ediff on manifests of the marked generations." + (interactive "P") + (if arg + (guix-generation-list-ediff-manifests) + (guix-generation-list-ediff-packages))) + +(defun guix-generation-list-diff (arg) + "Run Diff on package outputs installed in the 2 marked generations. +With ARG, run Diff on manifests of the marked generations." + (interactive "P") + (if arg + (guix-generation-list-diff-manifests) + (guix-generation-list-diff-packages))) + +(defun guix-generation-list-mark-delete (&optional arg) + "Mark the current generation for deletion and move to the next line. +With ARG, mark all generations for deletion." + (interactive "P") + (if arg + (guix-list-mark-all 'delete) + (guix-list--mark 'delete t))) + +(defun guix-generation-list-execute () + "Delete marked generations." + (interactive) + (let ((marked (guix-list-get-marked-id-list 'delete))) + (or marked + (user-error "No generations marked for deletion")) + (guix-delete-generations (guix-ui-current-profile) + marked (current-buffer)))) + + +;;; Inserting packages to compare generations + +(defcustom guix-generation-packages-buffer-name-function + #'guix-generation-packages-buffer-name-default + "Function used to define name of a buffer with generation packages. +This function is called with 2 arguments: PROFILE (string) and +GENERATION (number)." + :type '(choice (function-item guix-generation-packages-buffer-name-default) + (function-item guix-generation-packages-buffer-name-long) + (function :tag "Other function")) + :group 'guix-generation) + +(defcustom guix-generation-packages-update-buffer t + "If non-nil, always update list of packages during comparing generations. +If nil, generation packages are received only once. So when you +compare generation 1 and generation 2, the packages for both +generations will be received. Then if you compare generation 1 +and generation 3, only the packages for generation 3 will be +received. Thus if you use comparing of different generations a +lot, you may set this variable to nil to improve the +performance." + :type 'boolean + :group 'guix-generation) + +(defvar guix-generation-output-name-width 30 + "Width of an output name \"column\". +This variable is used in auxiliary buffers for comparing generations.") + +(defun guix-generation-packages (profile generation) + "Return a list of sorted packages installed in PROFILE's GENERATION. +Each element of the list is a list of the package specification +and its store path." + (let ((names+paths (guix-eval-read + (guix-make-guile-expression + 'generation-package-specifications+paths + profile generation)))) + (sort names+paths + (lambda (a b) + (string< (car a) (car b)))))) + +(defun guix-generation-packages-buffer-name-default (profile generation) + "Return name of a buffer for displaying GENERATION's package outputs. +Use base name of PROFILE file name." + (let ((profile-name (file-name-base (directory-file-name profile)))) + (format "*Guix %s: generation %s*" + profile-name generation))) + +(defun guix-generation-packages-buffer-name-long (profile generation) + "Return name of a buffer for displaying GENERATION's package outputs. +Use the full PROFILE file name." + (format "*Guix generation %s (%s)*" + generation profile)) + +(defun guix-generation-packages-buffer-name (profile generation) + "Return name of a buffer for displaying GENERATION's package outputs." + (funcall guix-generation-packages-buffer-name-function + profile generation)) + +(defun guix-generation-insert-package (name path) + "Insert package output NAME and store PATH at point." + (insert name) + (indent-to guix-generation-output-name-width 2) + (insert path "\n")) + +(defun guix-generation-insert-packages (buffer profile generation) + "Insert package outputs installed in PROFILE's GENERATION in BUFFER." + (with-current-buffer buffer + (setq buffer-read-only nil + indent-tabs-mode nil) + (erase-buffer) + (mapc (lambda (name+path) + (guix-generation-insert-package + (car name+path) (cadr name+path))) + (guix-generation-packages profile generation)))) + +(defun guix-generation-packages-buffer (profile generation) + "Return buffer with package outputs installed in PROFILE's GENERATION. +Create the buffer if needed." + (let ((buf-name (guix-generation-packages-buffer-name + profile generation))) + (or (and (null guix-generation-packages-update-buffer) + (get-buffer buf-name)) + (let ((buf (get-buffer-create buf-name))) + (guix-generation-insert-packages buf profile generation) + buf)))) + +(defun guix-profile-generation-manifest-file (generation) + "Return the file name of a GENERATION's manifest. +GENERATION is a generation number of the current profile." + (guix-manifest-file (guix-ui-current-profile) generation)) + +(defun guix-profile-generation-packages-buffer (generation) + "Insert GENERATION's package outputs in a buffer and return it. +GENERATION is a generation number of the current profile." + (guix-generation-packages-buffer (guix-ui-current-profile) + generation)) + + +;;; Interactive commands + +;;;###autoload +(defun guix-generations (&optional profile) + "Display information about all generations. +If PROFILE is nil, use `guix-current-profile'. +Interactively with prefix, prompt for PROFILE." + (interactive + (list (and current-prefix-arg + (guix-profile-prompt)))) + (guix-generation-get-display profile 'all)) + +;;;###autoload +(defun guix-last-generations (number &optional profile) + "Display information about last NUMBER generations. +If PROFILE is nil, use `guix-current-profile'. +Interactively with prefix, prompt for PROFILE." + (interactive + (list (read-number "The number of last generations: ") + (and current-prefix-arg + (guix-profile-prompt)))) + (guix-generation-get-display profile 'last number)) + +;;;###autoload +(defun guix-generations-by-time (from to &optional profile) + "Display information about generations created between FROM and TO. +FROM and TO should be time values. +If PROFILE is nil, use `guix-current-profile'. +Interactively with prefix, prompt for PROFILE." + (interactive + (list (guix-read-date "Find generations (from): ") + (guix-read-date "Find generations (to): ") + (and current-prefix-arg + (guix-profile-prompt)))) + (guix-generation-get-display profile 'time + (float-time from) + (float-time to))) + +(provide 'guix-ui-generation) + +;;; guix-ui-generation.el ends here diff --git a/emacs/guix-ui-package.el b/emacs/guix-ui-package.el new file mode 100644 index 0000000000..299822aae9 --- /dev/null +++ b/emacs/guix-ui-package.el @@ -0,0 +1,958 @@ +;;; guix-ui-package.el --- Interface for displaying packages -*- lexical-binding: t -*- + +;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com> + +;; This file is part of GNU Guix. + +;; GNU Guix is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Guix is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This file provides an interface for displaying packages and outputs +;; in 'list' and 'info' buffers, and commands for working with them. + +;;; Code: + +(require 'cl-lib) +(require 'guix-buffer) +(require 'guix-list) +(require 'guix-info) +(require 'guix-ui) +(require 'guix-base) +(require 'guix-backend) +(require 'guix-guile) +(require 'guix-entry) +(require 'guix-utils) + +(defgroup guix-package nil + "Interface for displaying packages and outputs." + :group 'guix-ui) + +(defcustom guix-package-list-type 'output + "Define how to display packages in 'list' buffer. +Should 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) + +(defcustom guix-package-info-type 'package + "Define how to display packages in 'info' buffer. +Should be a symbol `package' or `output' (if `output', display +each output separately; if `package', display outputs inside +package data)." + :type '(choice (const :tag "Display packages" package) + (const :tag "Display outputs" output)) + :group 'guix-package) + +(defcustom guix-package-list-single nil + "If non-nil, list a package even if it is the only matching result. +If nil, show a single package in the info buffer." + :type 'boolean + :group 'guix) + +(defun guix-package-get-display (profile search-type &rest search-values) + "Search for packages/outputs and show results. + +If PROFILE is nil, use `guix-current-profile'. + +See `guix-ui-get-entries' for the meaning of SEARCH-TYPE and +SEARCH-VALUES. + +Results are displayed in the list buffer, unless a single package +is found and `guix-package-list-single' is nil." + (let* ((args (cl-list* (or profile guix-current-profile) + search-type search-values)) + (entries (guix-buffer-get-entries + 'list guix-package-list-type args))) + (if (or guix-package-list-single + (null entries) + (cdr entries)) + (guix-buffer-display-entries + entries 'list guix-package-list-type args 'add) + (guix-buffer-get-display-entries + 'info guix-package-info-type args 'add)))) + +(defun guix-package-entry->name-specification (entry &optional output) + "Return name specification of the package ENTRY and OUTPUT." + (guix-package-name-specification + (guix-entry-value entry 'name) + (guix-entry-value entry 'version) + (or output (guix-entry-value entry 'output)))) + +(defun guix-package-entries->name-specifications (entries) + "Return name specifications by the package or output ENTRIES." + (cl-remove-duplicates (mapcar #'guix-package-entry->name-specification + entries) + :test #'string=)) + +(defun guix-package-installed-outputs (entry) + "Return a list of installed outputs for the package ENTRY." + (mapcar (lambda (installed-entry) + (guix-entry-value installed-entry 'output)) + (guix-entry-value entry 'installed))) + +(defun guix-package-id-and-output-by-output-id (output-id) + "Return a list (PACKAGE-ID OUTPUT) by OUTPUT-ID." + (cl-multiple-value-bind (package-id-str output) + (split-string output-id ":") + (let ((package-id (string-to-number package-id-str))) + (list (if (= 0 package-id) package-id-str package-id) + output)))) + + +;;; Processing package actions + +(defun guix-process-package-actions (profile actions + &optional operation-buffer) + "Process package ACTIONS on PROFILE. +Each action is a list of the form: + + (ACTION-TYPE PACKAGE-SPEC ...) + +ACTION-TYPE is one of the following symbols: `install', +`upgrade', `remove'/`delete'. +PACKAGE-SPEC should have the following form: (ID [OUTPUT] ...)." + (let (install upgrade remove) + (mapc (lambda (action) + (let ((action-type (car action)) + (specs (cdr action))) + (cl-case action-type + (install (setq install (append install specs))) + (upgrade (setq upgrade (append upgrade specs))) + ((remove delete) (setq remove (append remove specs)))))) + actions) + (when (guix-continue-package-operation-p + profile + :install install :upgrade upgrade :remove remove) + (guix-eval-in-repl + (guix-make-guile-expression + 'process-package-actions profile + :install install :upgrade upgrade :remove remove + :use-substitutes? (or guix-use-substitutes 'f) + :dry-run? (or guix-dry-run 'f)) + (and (not guix-dry-run) operation-buffer))))) + +(cl-defun guix-continue-package-operation-p (profile + &key install upgrade remove) + "Return non-nil if a package operation should be continued. +Ask a user if needed (see `guix-operation-confirm'). +INSTALL, UPGRADE, REMOVE are 'package action specifications'. +See `guix-process-package-actions' for details." + (or (null guix-operation-confirm) + (let* ((entries (guix-ui-get-entries + profile 'package 'id + (append (mapcar #'car install) + (mapcar #'car upgrade) + (mapcar #'car remove)) + '(id name version location))) + (install-strings (guix-get-package-strings install entries)) + (upgrade-strings (guix-get-package-strings upgrade entries)) + (remove-strings (guix-get-package-strings remove entries))) + (if (or install-strings upgrade-strings remove-strings) + (let ((buf (get-buffer-create guix-temp-buffer-name))) + (with-current-buffer buf + (setq-local cursor-type nil) + (setq buffer-read-only nil) + (erase-buffer) + (insert "Profile: " profile "\n\n") + (guix-insert-package-strings install-strings "install") + (guix-insert-package-strings upgrade-strings "upgrade") + (guix-insert-package-strings remove-strings "remove") + (let ((win (temp-buffer-window-show + buf + '((display-buffer-reuse-window + display-buffer-at-bottom) + (window-height . fit-window-to-buffer))))) + (prog1 (guix-operation-prompt) + (quit-window nil win))))) + (message "Nothing to be done. +If Guix REPL was restarted, the data is not up-to-date.") + nil)))) + +(defun guix-get-package-strings (specs entries) + "Return short package descriptions for performing package actions. +See `guix-process-package-actions' for the meaning of SPECS. +ENTRIES is a list of package entries to get info about packages." + (delq nil + (mapcar + (lambda (spec) + (let* ((id (car spec)) + (outputs (cdr spec)) + (entry (guix-entry-by-id id entries))) + (when entry + (let ((location (guix-entry-value entry 'location))) + (concat (guix-package-entry->name-specification entry) + (when outputs + (concat ":" + (guix-concat-strings outputs ","))) + (when location + (concat "\t(" location ")"))))))) + specs))) + +(defun guix-insert-package-strings (strings action) + "Insert information STRINGS at point for performing package ACTION." + (when strings + (insert "Package(s) to " (propertize action 'face 'bold) ":\n") + (mapc (lambda (str) + (insert " " str "\n")) + strings) + (insert "\n"))) + + +;;; Package 'info' + +(guix-ui-info-define-interface package + :buffer-name "*Guix Package Info*" + :format '(guix-package-info-insert-heading + ignore + (synopsis ignore (simple guix-package-info-synopsis)) + ignore + (description ignore (simple guix-package-info-description)) + ignore + (outputs simple guix-package-info-insert-outputs) + (source simple guix-package-info-insert-source) + (location format (format guix-package-location)) + (home-url format (format guix-url)) + (license format (format guix-package-info-license)) + (inputs format (format guix-package-input)) + (native-inputs format (format guix-package-native-input)) + (propagated-inputs format + (format guix-package-propagated-input))) + :titles '((home-url . "Home page")) + :required '(id name version installed non-unique)) + +(guix-info-define-interface installed-output + :format '((path simple (indent guix-file)) + (dependencies simple (indent guix-file))) + :titles '((path . "Store directory")) + :reduced? t) + +(defface guix-package-info-heading + '((t :inherit guix-info-heading)) + "Face for package name and version headings." + :group 'guix-package-info-faces) + +(defface guix-package-info-name + '((t :inherit font-lock-keyword-face)) + "Face used for a name of a package." + :group 'guix-package-info-faces) + +(defface guix-package-info-name-button + '((t :inherit button)) + "Face used for a full name that can be used to describe a package." + :group 'guix-package-info-faces) + +(defface guix-package-info-version + '((t :inherit font-lock-builtin-face)) + "Face used for a version of a package." + :group 'guix-package-info-faces) + +(defface guix-package-info-synopsis + '((((type tty pc) (class color)) :weight bold) + (t :height 1.1 :weight bold :inherit variable-pitch)) + "Face used for a synopsis of a package." + :group 'guix-package-info-faces) + +(defface guix-package-info-description + '((t)) + "Face used for a description of a package." + :group 'guix-package-info-faces) + +(defface guix-package-info-license + '((t :inherit font-lock-string-face)) + "Face used for a license of a package." + :group 'guix-package-info-faces) + +(defface guix-package-info-location + '((t :inherit link)) + "Face used for a location of a package." + :group 'guix-package-info-faces) + +(defface guix-package-info-source + '((t :inherit link :underline nil)) + "Face used for a source URL of a package." + :group 'guix-package-info-faces) + +(defface guix-package-info-installed-outputs + '((default :weight bold) + (((class color) (min-colors 88) (background light)) + :foreground "ForestGreen") + (((class color) (min-colors 88) (background dark)) + :foreground "PaleGreen") + (((class color) (min-colors 8)) + :foreground "green") + (t :underline t)) + "Face used for installed outputs of a package." + :group 'guix-package-info-faces) + +(defface guix-package-info-uninstalled-outputs + '((t :weight bold)) + "Face used for uninstalled outputs of a package." + :group 'guix-package-info-faces) + +(defface guix-package-info-obsolete + '((t :inherit error)) + "Face used if a package is obsolete." + :group 'guix-package-info-faces) + +(defcustom guix-package-info-auto-find-source nil + "If non-nil, find a source file after pressing a \"Show\" button. +If nil, just display the source file path without finding." + :type 'boolean + :group 'guix-package-info) + +(defcustom guix-package-info-auto-download-source t + "If nil, do not automatically download a source file if it doesn't exist. +After pressing a \"Show\" button, a derivation of the package +source is calculated and a store file path is displayed. If this +variable is non-nil and the source file does not exist in the +store, it will be automatically downloaded (with a possible +prompt depending on `guix-operation-confirm' variable)." + :type 'boolean + :group 'guix-package-info) + +(defvar guix-package-info-download-buffer nil + "Buffer from which a current download operation was performed.") + +(defvar guix-package-info-output-format "%-10s" + "String used to format output names of the packages. +It should be a '%s'-sequence. After inserting an output name +formatted with this string, an action button is inserted.") + +(defvar guix-package-info-obsolete-string "(This package is obsolete)" + "String used if a package is obsolete.") + +(define-button-type 'guix-package-location + :supertype 'guix + 'face 'guix-package-info-location + 'help-echo "Find location of this package" + 'action (lambda (btn) + (guix-find-location (button-label btn)))) + +(define-button-type 'guix-package-name + :supertype 'guix + 'face 'guix-package-info-name-button + 'help-echo "Describe this package" + 'action (lambda (btn) + (guix-buffer-get-display-entries-current + 'info guix-package-info-type + (list (guix-ui-current-profile) + 'name (button-label btn)) + 'add))) + +(define-button-type 'guix-package-source + :supertype 'guix + 'face 'guix-package-info-source + 'help-echo "" + 'action (lambda (_) + ;; As a source may not be a real URL (e.g., "mirror://..."), + ;; no action is bound to a source button. + (message "Yes, this is the source URL. What did you expect?"))) + +(defun guix-package-info-insert-heading (entry) + "Insert package ENTRY heading (name specification) at point." + (guix-insert-button + (guix-package-entry->name-specification entry) + 'guix-package-name + 'face 'guix-package-info-heading)) + +(defmacro guix-package-info-define-insert-inputs (&optional type) + "Define a face and a function for inserting package inputs. +TYPE is a type of inputs. +Function name is `guix-package-info-insert-TYPE-inputs'. +Face name is `guix-package-info-TYPE-inputs'." + (let* ((type-str (symbol-name type)) + (type-name (and type (concat type-str "-"))) + (type-desc (and type (concat type-str " "))) + (face (intern (concat "guix-package-info-" type-name "inputs"))) + (btn (intern (concat "guix-package-" type-name "input")))) + `(progn + (defface ,face + '((t :inherit guix-package-info-name-button)) + ,(concat "Face used for " type-desc "inputs of a package.") + :group 'guix-package-info-faces) + + (define-button-type ',btn + :supertype 'guix-package-name + 'face ',face)))) + +(guix-package-info-define-insert-inputs) +(guix-package-info-define-insert-inputs native) +(guix-package-info-define-insert-inputs propagated) + +(defun guix-package-info-insert-outputs (outputs entry) + "Insert OUTPUTS from package ENTRY at point." + (and (guix-entry-value entry 'obsolete) + (guix-package-info-insert-obsolete-text)) + (and (guix-entry-value entry 'non-unique) + (guix-entry-value entry 'installed) + (guix-package-info-insert-non-unique-text + (guix-package-entry->name-specification entry))) + (insert "\n") + (dolist (output outputs) + (guix-package-info-insert-output output entry))) + +(defun guix-package-info-insert-obsolete-text () + "Insert a message about obsolete package at point." + (guix-info-insert-indent) + (guix-format-insert guix-package-info-obsolete-string + 'guix-package-info-obsolete)) + +(defun guix-package-info-insert-non-unique-text (full-name) + "Insert a message about non-unique package with FULL-NAME at point." + (insert "\n") + (guix-info-insert-indent) + (insert "Installed outputs are displayed for a non-unique ") + (guix-insert-button full-name 'guix-package-name) + (insert " package.")) + +(defun guix-package-info-insert-output (output entry) + "Insert OUTPUT at point. +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-entry-value entry 'installed)) + (obsolete (guix-entry-value entry 'obsolete)) + (installed-entry (cl-find-if + (lambda (entry) + (string= (guix-entry-value entry 'output) + output)) + installed)) + (action-type (if installed-entry 'delete 'install))) + (guix-info-insert-indent) + (guix-format-insert output + (if installed-entry + 'guix-package-info-installed-outputs + 'guix-package-info-uninstalled-outputs) + guix-package-info-output-format) + (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)) + (insert "\n") + (when installed-entry + (guix-info-insert-entry installed-entry 'installed-output 2)))) + +(defun guix-package-info-insert-action-button (type entry output) + "Insert button to process an action on a package OUTPUT at point. +TYPE is one of the following symbols: `install', `delete', `upgrade'. +ENTRY is an alist with package info." + (let ((type-str (capitalize (symbol-name type))) + (full-name (guix-package-entry->name-specification entry output))) + (guix-info-insert-action-button + type-str + (lambda (btn) + (guix-process-package-actions + (guix-ui-current-profile) + `((,(button-get btn 'action-type) (,(button-get btn 'id) + ,(button-get btn 'output)))) + (current-buffer))) + (concat type-str " '" full-name "'") + 'action-type type + 'id (or (guix-entry-value entry 'package-id) + (guix-entry-id entry)) + 'output output))) + +(defun guix-package-info-show-source (entry-id package-id) + "Show file name of a package source in the current info buffer. +Find the file if needed (see `guix-package-info-auto-find-source'). +ENTRY-ID is an ID of the current entry (package or output). +PACKAGE-ID is an ID of the package which source to show." + (let* ((entries (guix-buffer-current-entries)) + (entry (guix-entry-by-id entry-id entries)) + (file (guix-package-source-path package-id))) + (or file + (error "Couldn't define file name of the package source")) + (let* ((new-entry (cons (cons 'source-file file) + entry)) + (new-entries (guix-replace-entry entry-id new-entry entries))) + (setf (guix-buffer-item-entries guix-buffer-item) + new-entries) + (guix-buffer-redisplay-goto-button) + (if (file-exists-p file) + (if guix-package-info-auto-find-source + (guix-find-file file) + (message "The source store path is displayed.")) + (if guix-package-info-auto-download-source + (guix-package-info-download-source package-id) + (message "The source does not exist in the store.")))))) + +(defun guix-package-info-download-source (package-id) + "Download a source of the package PACKAGE-ID." + (setq guix-package-info-download-buffer (current-buffer)) + (guix-package-source-build-derivation + package-id + "The source does not exist in the store. Download it?")) + +(defun guix-package-info-insert-source (source entry) + "Insert SOURCE from package ENTRY at point. +SOURCE is a list of URLs." + (if (null source) + (guix-format-insert nil) + (let* ((source-file (guix-entry-value entry 'source-file)) + (entry-id (guix-entry-id entry)) + (package-id (or (guix-entry-value entry 'package-id) + entry-id))) + (if (null source-file) + (guix-info-insert-action-button + "Show" + (lambda (btn) + (guix-package-info-show-source (button-get btn 'entry-id) + (button-get btn 'package-id))) + "Show the source store directory of the current package" + 'entry-id entry-id + 'package-id package-id) + (unless (file-exists-p source-file) + (guix-info-insert-action-button + "Download" + (lambda (btn) + (guix-package-info-download-source + (button-get btn 'package-id))) + "Download the source into the store" + 'package-id package-id)) + (guix-info-insert-value-indent source-file 'guix-file)) + (guix-info-insert-value-indent source 'guix-package-source)))) + +(defun guix-package-info-redisplay-after-download () + "Redisplay an 'info' buffer after downloading the package source. +This function is used to hide a \"Download\" button if needed." + (when (buffer-live-p guix-package-info-download-buffer) + (with-current-buffer guix-package-info-download-buffer + (guix-buffer-redisplay-goto-button)) + (setq guix-package-info-download-buffer nil))) + +(add-hook 'guix-after-source-download-hook + 'guix-package-info-redisplay-after-download) + + +;;; Package 'list' + +(guix-ui-list-define-interface package + :buffer-name "*Guix Package List*" + :format '((name guix-package-list-get-name 20 t) + (version nil 10 nil) + (outputs nil 13 t) + (installed guix-package-list-get-installed-outputs 13 t) + (synopsis guix-list-get-one-line 30 nil)) + :sort-key '(name) + :marks '((install . ?I) + (upgrade . ?U) + (delete . ?D))) + +(let ((map guix-package-list-mode-map)) + (define-key map (kbd "e") 'guix-package-list-edit) + (define-key map (kbd "x") 'guix-package-list-execute) + (define-key map (kbd "i") 'guix-package-list-mark-install) + (define-key map (kbd "d") 'guix-package-list-mark-delete) + (define-key map (kbd "U") 'guix-package-list-mark-upgrade) + (define-key map (kbd "^") 'guix-package-list-mark-upgrades)) + +(defface guix-package-list-installed + '((t :inherit guix-package-info-installed-outputs)) + "Face used if there are installed outputs for the current package." + :group 'guix-package-list-faces) + +(defface guix-package-list-obsolete + '((t :inherit guix-package-info-obsolete)) + "Face used if a package is obsolete." + :group 'guix-package-list-faces) + +(defcustom guix-package-list-generation-marking-enabled nil + "If non-nil, allow putting marks in a list with 'generation packages'. + +By default this is disabled, because it may be confusing. For +example, a package is installed in some generation, so a user can +mark it for deletion in the list of packages from this +generation, but the package may not be installed in the latest +generation, so actually it cannot be deleted. + +If you managed to understand the explanation above or if you +really know what you do or if you just don't care, you can set +this variable to t. It should not do much harm anyway (most +likely)." + :type 'boolean + :group 'guix-package-list) + +(defun guix-package-list-get-name (name entry) + "Return NAME of the package ENTRY. +Colorize it with `guix-package-list-installed' or +`guix-package-list-obsolete' if needed." + (guix-get-string name + (cond ((guix-entry-value entry 'obsolete) + 'guix-package-list-obsolete) + ((guix-entry-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-entry-value entry 'output)) + installed))) + +(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) + (or (derived-mode-p 'guix-package-list-mode) + (derived-mode-p 'guix-output-list-mode)) + (eq (guix-ui-current-search-type) 'generation)) + (error "Action marks are disabled for lists of 'generation packages'"))) + +(defun guix-package-list-mark-outputs (mark default + &optional prompt available) + "Mark the current package with MARK and move to the next line. +If PROMPT is non-nil, use it to ask a user for outputs from +AVAILABLE list, otherwise mark all DEFAULT outputs." + (let ((outputs (if prompt + (guix-completing-read-multiple + prompt available nil t) + default))) + (apply #'guix-list--mark mark t outputs))) + +(defun guix-package-list-mark-install (&optional arg) + "Mark the current package for installation and move to the next line. +With ARG, prompt for the outputs to install (several outputs may +be separated with \",\")." + (interactive "P") + (guix-package-list-marking-check) + (let* ((entry (guix-list-current-entry)) + (all (guix-entry-value entry 'outputs)) + (installed (guix-package-installed-outputs entry)) + (available (cl-set-difference all installed :test #'string=))) + (or available + (user-error "This package is already installed")) + (guix-package-list-mark-outputs + 'install '("out") + (and arg "Output(s) to install: ") + available))) + +(defun guix-package-list-mark-delete (&optional arg) + "Mark the current package for deletion and move to the next line. +With ARG, prompt for the outputs to delete (several outputs may +be separated with \",\")." + (interactive "P") + (guix-package-list-marking-check) + (let* ((entry (guix-list-current-entry)) + (installed (guix-package-installed-outputs entry))) + (or installed + (user-error "This package is not installed")) + (guix-package-list-mark-outputs + 'delete installed + (and arg "Output(s) to delete: ") + installed))) + +(defun guix-package-list-mark-upgrade (&optional arg) + "Mark the current package for upgrading and move to the next line. +With ARG, prompt for the outputs to upgrade (several outputs may +be separated with \",\")." + (interactive "P") + (guix-package-list-marking-check) + (let* ((entry (guix-list-current-entry)) + (installed (guix-package-installed-outputs entry))) + (or installed + (user-error "This package is not installed")) + (when (or (guix-entry-value entry 'obsolete) + (y-or-n-p "This package is not obsolete. Try to upgrade it anyway? ")) + (guix-package-list-mark-outputs + 'upgrade installed + (and arg "Output(s) to upgrade: ") + installed)))) + +(defun guix-package-mark-upgrades (fun) + "Mark all obsolete packages for upgrading. +Use FUN to perform marking of the current line. FUN should +take an entry as argument." + (guix-package-list-marking-check) + (let ((obsolete (cl-remove-if-not + (lambda (entry) + (guix-entry-value entry 'obsolete)) + (guix-buffer-current-entries)))) + (guix-list-for-each-line + (lambda () + (let* ((id (guix-list-current-id)) + (entry (cl-find-if + (lambda (entry) + (equal id (guix-entry-id entry))) + obsolete))) + (when entry + (funcall fun entry))))))) + +(defun guix-package-list-mark-upgrades () + "Mark all obsolete packages for upgrading." + (interactive) + (guix-package-mark-upgrades + (lambda (entry) + (apply #'guix-list--mark + 'upgrade nil + (guix-package-installed-outputs entry))))) + +(defun guix-package-execute-actions (fun) + "Perform actions on the marked packages. +Use FUN to define actions suitable for `guix-process-package-actions'. +FUN should take action-type as argument." + (let ((actions (delq nil + (mapcar fun '(install delete upgrade))))) + (if actions + (guix-process-package-actions (guix-ui-current-profile) + actions (current-buffer)) + (user-error "No operations specified")))) + +(defun guix-package-list-execute () + "Perform actions on the marked packages." + (interactive) + (guix-package-execute-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. +The specification is suitable for `guix-process-package-actions'." + (let ((specs (guix-list-get-marked-args action-type))) + (and specs (cons action-type specs)))) + +(defun guix-package-list-edit () + "Go to the location of the current package." + (interactive) + (guix-edit (guix-list-current-id))) + + +;;; Output 'info' + +(guix-ui-info-define-interface output + :buffer-name "*Guix Package Info*" + :format '((name format (format guix-package-info-name)) + (version format guix-output-info-insert-version) + (output format guix-output-info-insert-output) + (synopsis simple (indent guix-package-info-synopsis)) + (source simple guix-package-info-insert-source) + (path simple (indent guix-file)) + (dependencies simple (indent guix-file)) + (location format (format guix-package-location)) + (home-url format (format guix-url)) + (license format (format guix-package-info-license)) + (inputs format (format guix-package-input)) + (native-inputs format (format guix-package-native-input)) + (propagated-inputs format + (format guix-package-propagated-input)) + (description simple (indent guix-package-info-description))) + :titles guix-package-info-titles + :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-value-format version + 'guix-package-info-version) + (and (guix-entry-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-entry-value entry 'installed)) + (obsolete (guix-entry-value entry 'obsolete)) + (action-type (if installed 'delete 'install))) + (guix-info-insert-value-format + 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)))) + + +;;; Output 'list' + +(guix-ui-list-define-interface output + :buffer-name "*Guix Package List*" + :describe-function 'guix-output-list-describe + :format '((name guix-package-list-get-name 20 t) + (version nil 10 nil) + (output nil 9 t) + (installed nil 12 t) + (synopsis guix-list-get-one-line 30 nil)) + :required '(id package-id) + :sort-key '(name) + :marks '((install . ?I) + (upgrade . ?U) + (delete . ?D))) + +(let ((map guix-output-list-mode-map)) + (define-key map (kbd "e") 'guix-output-list-edit) + (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-entry-value 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-entry-value 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 upgrading and move to the next line." + (interactive) + (guix-package-list-marking-check) + (let* ((entry (guix-list-current-entry)) + (installed (guix-entry-value entry 'installed))) + (or installed + (user-error "This output is not installed")) + (when (or (guix-entry-value 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-package-mark-upgrades + (lambda (_) (guix-list--mark 'upgrade)))) + +(defun guix-output-list-execute () + "Perform actions on the marked outputs." + (interactive) + (guix-package-execute-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-package-id-and-output-by-output-id + ids))))) + +(defun guix-output-list-describe (ids) + "Describe outputs with IDS (list of output identifiers). +See `guix-package-info-type'." + (if (eq guix-package-info-type 'output) + (guix-buffer-get-display-entries + 'info 'output + (cl-list* (guix-ui-current-profile) 'id ids) + 'add) + (let ((pids (mapcar (lambda (oid) + (car (guix-package-id-and-output-by-output-id + oid))) + ids))) + (guix-buffer-get-display-entries + 'info 'package + (cl-list* (guix-ui-current-profile) + 'id (cl-remove-duplicates pids)) + 'add)))) + +(defun guix-output-list-edit () + "Go to the location of the current package." + (interactive) + (guix-edit (guix-entry-value (guix-list-current-entry) + 'package-id))) + + +;;; Interactive commands + +(defvar guix-package-search-params '(name synopsis description) + "Default list of package parameters for searching by regexp.") + +(defvar guix-package-search-history nil + "A history of minibuffer prompts.") + +;;;###autoload +(defun guix-search-by-name (name &optional profile) + "Search for Guix packages by NAME. +NAME is a string with name specification. It may optionally contain +a version number. Examples: \"guile\", \"guile-2.0.11\". + +If PROFILE is nil, use `guix-current-profile'. +Interactively with prefix, prompt for PROFILE." + (interactive + (list (read-string "Package name: " nil 'guix-package-search-history) + (and current-prefix-arg + (guix-profile-prompt)))) + (guix-package-get-display profile 'name name)) + +;;;###autoload +(defun guix-search-by-regexp (regexp &optional params profile) + "Search for Guix packages by REGEXP. +PARAMS are package parameters that should be searched. +If PARAMS are not specified, use `guix-package-search-params'. + +If PROFILE is nil, use `guix-current-profile'. +Interactively with prefix, prompt for PROFILE." + (interactive + (list (read-regexp "Regexp: " nil 'guix-package-search-history) + nil + (and current-prefix-arg + (guix-profile-prompt)))) + (guix-package-get-display profile 'regexp regexp + (or params guix-package-search-params))) + +;;;###autoload +(defun guix-installed-packages (&optional profile) + "Display information about installed Guix packages. +If PROFILE is nil, use `guix-current-profile'. +Interactively with prefix, prompt for PROFILE." + (interactive + (list (and current-prefix-arg + (guix-profile-prompt)))) + (guix-package-get-display profile 'installed)) + +;;;###autoload +(defun guix-obsolete-packages (&optional profile) + "Display information about obsolete Guix packages. +If PROFILE is nil, use `guix-current-profile'. +Interactively with prefix, prompt for PROFILE." + (interactive + (list (and current-prefix-arg + (guix-profile-prompt)))) + (guix-package-get-display profile 'obsolete)) + +;;;###autoload +(defun guix-all-available-packages (&optional profile) + "Display information about all available Guix packages. +If PROFILE is nil, use `guix-current-profile'. +Interactively with prefix, prompt for PROFILE." + (interactive + (list (and current-prefix-arg + (guix-profile-prompt)))) + (guix-package-get-display profile 'all-available)) + +;;;###autoload +(defun guix-newest-available-packages (&optional profile) + "Display information about the newest available Guix packages. +If PROFILE is nil, use `guix-current-profile'. +Interactively with prefix, prompt for PROFILE." + (interactive + (list (and current-prefix-arg + (guix-profile-prompt)))) + (guix-package-get-display profile 'newest-available)) + +(provide 'guix-ui-package) + +;;; guix-ui-package.el ends here diff --git a/emacs/guix.el b/emacs/guix.el deleted file mode 100644 index 12dd4a2553..0000000000 --- a/emacs/guix.el +++ /dev/null @@ -1,210 +0,0 @@ -;;; guix.el --- Interface for GNU Guix package manager - -;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com> - -;; Package-Requires: ((geiser "0.3")) -;; Keywords: tools - -;; This file is part of GNU Guix. - -;; GNU Guix is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Guix is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This package provides an interface for searching, listing and getting -;; information about Guix packages and generations; and for -;; installing/upgrading/removing packages. - -;;; Code: - -(require 'guix-base) -(require 'guix-list) -(require 'guix-info) -(require 'guix-utils) -(require 'guix-read) - -(defgroup guix nil - "Interface for Guix package manager." - :prefix "guix-" - :group 'external) - -(defgroup guix-faces nil - "Guix faces." - :group 'guix - :group 'faces) - -(defcustom guix-list-single-package nil - "If non-nil, list a package even if it is the only matching result. -If nil, show a single package in the info buffer." - :type 'boolean - :group 'guix) - -(defvar guix-search-params '(name synopsis description) - "Default list of package parameters for searching by regexp.") - -(defvar guix-search-history nil - "A history of minibuffer prompts.") - -(defun guix-get-show-packages (profile search-type &rest search-values) - "Search for packages and show results. - -If PROFILE is nil, use `guix-current-profile'. - -See `guix-ui-get-entries' for the meaning of SEARCH-TYPE and -SEARCH-VALUES. - -Results are displayed in the list buffer, unless a single package -is found and `guix-list-single-package' is nil." - (let* ((args (cl-list* (or profile guix-current-profile) - search-type search-values)) - (entries (guix-buffer-get-entries - 'list guix-package-list-type args))) - (if (or guix-list-single-package - (null entries) - (cdr entries)) - (guix-buffer-display-entries - entries 'list guix-package-list-type args 'add) - (guix-buffer-get-display-entries - 'info guix-package-info-type args 'add)))) - -(defun guix-get-show-generations (profile search-type &rest search-values) - "Search for generations and show results. - -If PROFILE is nil, use `guix-current-profile'. - -See `guix-ui-get-entries' for the meaning of SEARCH-TYPE and -SEARCH-VALUES." - (let ((args (cl-list* (or profile guix-current-profile) - search-type search-values))) - (guix-buffer-get-display-entries - 'list 'generation args 'add))) - -;;;###autoload -(defun guix-search-by-name (name &optional profile) - "Search for Guix packages by NAME. -NAME is a string with name specification. It may optionally contain -a version number. Examples: \"guile\", \"guile-2.0.11\". - -If PROFILE is nil, use `guix-current-profile'. -Interactively with prefix, prompt for PROFILE." - (interactive - (list (read-string "Package name: " nil 'guix-search-history) - (and current-prefix-arg - (guix-profile-prompt)))) - (guix-get-show-packages profile 'name name)) - -;;;###autoload -(defun guix-search-by-regexp (regexp &optional params profile) - "Search for Guix packages by REGEXP. -PARAMS are package parameters that should be searched. -If PARAMS are not specified, use `guix-search-params'. - -If PROFILE is nil, use `guix-current-profile'. -Interactively with prefix, prompt for PROFILE." - (interactive - (list (read-regexp "Regexp: " nil 'guix-search-history) - nil - (and current-prefix-arg - (guix-profile-prompt)))) - (guix-get-show-packages profile 'regexp regexp - (or params guix-search-params))) - -;;;###autoload -(defun guix-installed-packages (&optional profile) - "Display information about installed Guix packages. -If PROFILE is nil, use `guix-current-profile'. -Interactively with prefix, prompt for PROFILE." - (interactive - (list (and current-prefix-arg - (guix-profile-prompt)))) - (guix-get-show-packages profile 'installed)) - -;;;###autoload -(defun guix-obsolete-packages (&optional profile) - "Display information about obsolete Guix packages. -If PROFILE is nil, use `guix-current-profile'. -Interactively with prefix, prompt for PROFILE." - (interactive - (list (and current-prefix-arg - (guix-profile-prompt)))) - (guix-get-show-packages profile 'obsolete)) - -;;;###autoload -(defun guix-all-available-packages (&optional profile) - "Display information about all available Guix packages. -If PROFILE is nil, use `guix-current-profile'. -Interactively with prefix, prompt for PROFILE." - (interactive - (list (and current-prefix-arg - (guix-profile-prompt)))) - (guix-get-show-packages profile 'all-available)) - -;;;###autoload -(defun guix-newest-available-packages (&optional profile) - "Display information about the newest available Guix packages. -If PROFILE is nil, use `guix-current-profile'. -Interactively with prefix, prompt for PROFILE." - (interactive - (list (and current-prefix-arg - (guix-profile-prompt)))) - (guix-get-show-packages profile 'newest-available)) - -;;;###autoload -(defun guix-generations (&optional profile) - "Display information about all generations. -If PROFILE is nil, use `guix-current-profile'. -Interactively with prefix, prompt for PROFILE." - (interactive - (list (and current-prefix-arg - (guix-profile-prompt)))) - (guix-get-show-generations profile 'all)) - -;;;###autoload -(defun guix-last-generations (number &optional profile) - "Display information about last NUMBER generations. -If PROFILE is nil, use `guix-current-profile'. -Interactively with prefix, prompt for PROFILE." - (interactive - (list (read-number "The number of last generations: ") - (and current-prefix-arg - (guix-profile-prompt)))) - (guix-get-show-generations profile 'last number)) - -;;;###autoload -(defun guix-generations-by-time (from to &optional profile) - "Display information about generations created between FROM and TO. -FROM and TO should be time values. -If PROFILE is nil, use `guix-current-profile'. -Interactively with prefix, prompt for PROFILE." - (interactive - (list (guix-read-date "Find generations (from): ") - (guix-read-date "Find generations (to): ") - (and current-prefix-arg - (guix-profile-prompt)))) - (guix-get-show-generations profile 'time - (float-time from) - (float-time to))) - -;;;###autoload -(defun guix-edit (id-or-name) - "Edit (go to location of) package with ID-OR-NAME." - (interactive (list (guix-read-package-name))) - (let ((loc (guix-package-location id-or-name))) - (if loc - (guix-find-location loc) - (message "Couldn't find package location.")))) - -(provide 'guix) - -;;; guix.el ends here |