-;;; 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>
;;; 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."
- :prefix "guix-info-"
- :group 'guix)
-
-(defgroup guix-info-faces nil
- "Faces for info buffers."
- :group 'guix-info
- :group 'guix-faces)
+(guix-define-buffer-type info)
(defface guix-info-heading
'((((type tty pc) (class color)) :weight bold)
"Face used for titles of parameters."
:group 'guix-info-faces)
-(defface guix-info-file-path
+(defface guix-info-file-name
'((t :inherit link))
- "Face used for file paths."
+ "Face used for file names."
:group 'guix-info-faces)
(defface guix-info-url
(insert (guix-info-get-indent level)))
(defun guix-info-insert-entries (entries entry-type)
- "Display ENTRIES of ENTRY-TYPE in the current info buffer.
-ENTRIES should have a form of `guix-entries'."
+ "Display ENTRY-TYPE ENTRIES in the current info buffer."
(guix-mapinsert (lambda (entry)
(guix-info-insert-entry entry entry-type))
entries
(define-button-type 'guix-file
:supertype 'guix
- 'face 'guix-info-file-path
+ 'face 'guix-info-file-name
'help-echo "Find file"
'action (lambda (btn)
(guix-find-file (button-label btn))))
'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-get-show-entries guix-profile 'info guix-package-info-type
- 'name (button-label btn))))
-
(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."
"Keymap for `guix-info-mode' buffers.")
(define-derived-mode guix-info-mode special-mode "Guix-Info"
- "Parent mode for displaying information in info buffers.")
+ "Parent mode for displaying data in 'info' form."
+ (setq-local revert-buffer-function 'guix-buffer-revert))
+
+(defun guix-info-mode-initialize ()
+ "Set up the current 'info' buffer."
+ ;; Without this, syntactic fontification is performed, and it may
+ ;; break our highlighting. For example, description of "emacs-typo"
+ ;; package contains a single " (double-quote) character, so the
+ ;; default syntactic fontification highlights the rest text after it
+ ;; as a string. See (info "(elisp) Font Lock Basics") for details.
+ (setq font-lock-defaults '(nil t)))
(defmacro guix-info-define-interface (entry-type &rest args)
"Define 'info' interface for displaying ENTRY-TYPE entries.
(group (intern prefix))
(format-var (intern (concat prefix "-format"))))
(guix-keyword-args-let args
- ((format-val :format))
+ ((show-entries-val :show-entries-function)
+ (format-val :format))
`(progn
(defcustom ,format-var ,format-val
,(format "\
'((format . ,format-var))
'guix-info-data ',entry-type)
- (guix-buffer-define-interface info ,entry-type
- ,@%foreign-args)))))
-
-\f
-;;; 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)
-
-\f
-;;; 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-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)))
-
-\f
-;;; 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-entries)
- (entry (guix-entry-by-id entry-id guix-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)))
- (setq guix-entries 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)
-
-\f
-;;; 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))))
-
-\f
-;;; 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-get-show-entries guix-profile 'list guix-package-list-type
- 'generation (button-get btn 'number)))
- "Show installed packages for this generation"
- 'number number)
- (guix-info-insert-indent)
- (guix-info-insert-action-button
- "Delete"
- (lambda (btn)
- (guix-delete-generations guix-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-profile (button-get btn 'number)
- (current-buffer)))
- "Switch to this generation (make it the current one)"
- 'number (guix-entry-value entry 'number))))
+ ,(if show-entries-val
+ `(guix-buffer-define-interface info ,entry-type
+ :show-entries-function ,show-entries-val
+ ,@%foreign-args)
+
+ (let ((insert-fun (intern (concat prefix "-insert-entries"))))
+ `(progn
+ (defun ,insert-fun (entries)
+ ,(format "\
+Print '%s' ENTRIES in the current 'info' buffer."
+ entry-type-str)
+ (guix-info-insert-entries entries ',entry-type))
+
+ (guix-buffer-define-interface info ,entry-type
+ :insert-entries-function ',insert-fun
+ :mode-init-function 'guix-info-mode-initialize
+ ,@%foreign-args))))))))
\f
(defvar guix-info-font-lock-keywords
HCoop / jackhill / guix / guix.git / blobdiff