summary refs log tree commit diff
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.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")