diff options
Diffstat (limited to 'emacs/guix-info.el')
| -rw-r--r-- | emacs/guix-info.el | 455 |
1 files changed, 4 insertions, 451 deletions
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") |