aboutsummaryrefslogtreecommitdiff
path: root/emacs/guix-info.el
diff options
context:
space:
mode:
authorAlex Kost <alezost@gmail.com>2015-12-09 14:44:34 +0300
committerAlex Kost <alezost@gmail.com>2016-01-02 17:25:35 +0300
commitc80ce104bed39157347078020cbc45c65ff9b893 (patch)
treea6151b01dd94994065716c1edffba2fd9578c23b /emacs/guix-info.el
parentb1990426fdec1b0047a115116ac686c6dd4d4884 (diff)
downloadguix-c80ce104bed39157347078020cbc45c65ff9b893.tar
guix-c80ce104bed39157347078020cbc45c65ff9b893.tar.gz
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/guix-info.el')
-rw-r--r--emacs/guix-info.el455
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")