diff options
Diffstat (limited to 'emacs/guix-info.el')
| -rw-r--r-- | emacs/guix-info.el | 1007 |
1 files changed, 299 insertions, 708 deletions
diff --git a/emacs/guix-info.el b/emacs/guix-info.el index 1c7e79b954..644533eb29 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,23 +20,16 @@ ;;; 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) -(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) @@ -80,122 +73,115 @@ "Mouse face used for action buttons." :group 'guix-info-faces) -(defcustom guix-info-ignore-empty-vals nil +(defcustom guix-info-ignore-empty-values nil "If non-nil, do not display parameters with nil values." :type 'boolean :group 'guix-info) +(defcustom guix-info-fill t + "If non-nil, fill string parameters to fit the window. +If nil, insert text parameters (like synopsis or description) in +a raw form." + :type 'boolean + :group 'guix-info) + (defvar guix-info-param-title-format "%-18s: " "String used to format a title of a parameter. It should be a '%s'-sequence. After inserting a title formatted with this string, a value of the parameter is inserted. -This string is used by `guix-info-insert-title-default'.") +This string is used by `guix-info-insert-title-format'.") -(defvar guix-info-multiline-prefix (make-string 20 ?\s) +(defvar guix-info-multiline-prefix + (make-string (length (format guix-info-param-title-format " ")) + ?\s) "String used to format multi-line parameter values. If a value occupies more than one line, this string is inserted in the beginning of each line after the first one. -This string is used by `guix-info-insert-val-default'.") +This string is used by `guix-info-insert-value-format'.") (defvar guix-info-indent 2 "Number of spaces used to indent various parts of inserted text.") -(defvar guix-info-fill-column 60 - "Column used for filling (word wrapping) parameters with long lines. -If a value is not multi-line and it occupies more than this -number of characters, it will be split into several lines.") - (defvar guix-info-delimiter "\n\f\n" "String used to separate entries.") -(defvar guix-info-insert-methods - '((package - (name guix-package-info-name) - (version guix-package-info-version) - (license guix-package-info-license) - (synopsis guix-package-info-synopsis) - (description guix-package-info-insert-description - guix-info-insert-title-simple) - (outputs guix-package-info-insert-outputs - guix-info-insert-title-simple) - (source guix-package-info-insert-source - guix-info-insert-title-simple) - (home-url guix-info-insert-url) - (inputs guix-package-info-insert-inputs) - (native-inputs guix-package-info-insert-native-inputs) - (propagated-inputs guix-package-info-insert-propagated-inputs) - (location guix-package-info-insert-location)) - (installed - (path guix-package-info-insert-output-path - guix-info-insert-title-simple) - (dependencies guix-package-info-insert-output-dependencies - guix-info-insert-title-simple)) - (output - (name guix-package-info-name) - (version guix-output-info-insert-version) - (output guix-output-info-insert-output) - (source guix-package-info-insert-source - guix-info-insert-title-simple) - (path guix-package-info-insert-output-path - guix-info-insert-title-simple) - (dependencies guix-package-info-insert-output-dependencies - guix-info-insert-title-simple) - (license guix-package-info-license) - (synopsis guix-package-info-synopsis) - (description guix-package-info-insert-description - guix-info-insert-title-simple) - (home-url guix-info-insert-url) - (inputs guix-package-info-insert-inputs) - (native-inputs guix-package-info-insert-native-inputs) - (propagated-inputs guix-package-info-insert-propagated-inputs) - (location guix-package-info-insert-location)) - (generation - (number guix-generation-info-insert-number) - (current guix-generation-info-insert-current) - (path guix-info-insert-file-path) - (time guix-info-insert-time))) - "Methods for inserting parameter values. -Each element of the list should have a form: - - (ENTRY-TYPE . ((PARAM INSERT-VALUE [INSERT-TITLE]) ...)) - -INSERT-VALUE may be either nil, a face name or a function. If it -is nil or a face, `guix-info-insert-val-default' function is -called with parameter value and INSERT-VALUE as arguments. If it -is a function, this function is called with parameter value and -entry info (alist of parameters and their values) as arguments. - -INSERT-TITLE may be either nil, a face name or a function. If it -is nil or a face, `guix-info-insert-title-default' function is -called with parameter title and INSERT-TITLE as arguments. If it -is a function, this function is called with parameter title as -argument.") - -(defvar guix-info-displayed-params - '((package name version synopsis outputs source location home-url - license inputs native-inputs propagated-inputs description) - (output name version output synopsis source path dependencies location - home-url license inputs native-inputs propagated-inputs - description) - (installed path dependencies) - (generation number prev-number current time path)) - "List of displayed entry parameters. -Each element of the list should have a form: - - (ENTRY-TYPE . (PARAM ...)) - -The order of displayed parameters is the same as in this list.") - -(defun guix-info-get-insert-methods (entry-type param) - "Return list of insert methods for parameter PARAM of ENTRY-TYPE. -See `guix-info-insert-methods' for details." - (guix-assq-value guix-info-insert-methods - entry-type param)) - -(defun guix-info-get-displayed-params (entry-type) - "Return parameters of ENTRY-TYPE that should be displayed." - (guix-assq-value guix-info-displayed-params - entry-type)) + +;;; Wrappers for 'info' variables + +(defvar guix-info-data nil + "Alist with 'info' data. +This alist is filled by `guix-info-define-interface' macro.") + +(defun guix-info-value (entry-type symbol) + "Return SYMBOL's value for ENTRY-TYPE from `guix-info-data'." + (symbol-value (guix-assq-value guix-info-data entry-type symbol))) + +(defun guix-info-param-title (entry-type param) + "Return a title of an ENTRY-TYPE parameter PARAM." + (guix-buffer-param-title 'info entry-type param)) + +(defun guix-info-format (entry-type) + "Return 'info' format for ENTRY-TYPE." + (guix-info-value entry-type 'format)) + +(defun guix-info-displayed-params (entry-type) + "Return a list of ENTRY-TYPE parameters that should be displayed." + (delq nil + (mapcar (lambda (spec) + (pcase spec + (`(,param . ,_) param))) + (guix-info-format entry-type)))) + + +;;; Inserting entries + +(defvar guix-info-title-aliases + '((format . guix-info-insert-title-format) + (simple . guix-info-insert-title-simple)) + "Alist of aliases and functions to insert titles.") + +(defvar guix-info-value-aliases + '((format . guix-info-insert-value-format) + (indent . guix-info-insert-value-indent) + (simple . guix-info-insert-value-simple) + (time . guix-info-insert-time)) + "Alist of aliases and functions to insert values.") + +(defun guix-info-title-function (fun-or-alias) + "Convert FUN-OR-ALIAS into a function to insert a title." + (or (guix-assq-value guix-info-title-aliases fun-or-alias) + fun-or-alias)) + +(defun guix-info-value-function (fun-or-alias) + "Convert FUN-OR-ALIAS into a function to insert a value." + (or (guix-assq-value guix-info-value-aliases fun-or-alias) + fun-or-alias)) + +(defun guix-info-title-method->function (method) + "Convert title METHOD into a function to insert a title." + (pcase method + ((pred null) #'ignore) + ((pred symbolp) (guix-info-title-function method)) + (`(,fun-or-alias . ,rest-args) + (lambda (title) + (apply (guix-info-title-function fun-or-alias) + title rest-args))) + (_ (error "Unknown title method '%S'" method)))) + +(defun guix-info-value-method->function (method) + "Convert value METHOD into a function to insert a value." + (pcase method + ((pred null) #'ignore) + ((pred functionp) method) + (`(,fun-or-alias . ,rest-args) + (lambda (value _) + (apply (guix-info-value-function fun-or-alias) + value rest-args))) + (_ (error "Unknown value method '%S'" method)))) + +(defun guix-info-fill-column () + "Return fill column for the current window." + (min (window-width) fill-column)) (defun guix-info-get-indent (&optional level) "Return `guix-info-indent' \"multiplied\" by LEVEL spaces. @@ -207,124 +193,128 @@ LEVEL is 1 by default." (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 guix-info-delimiter)) -(defun guix-info-insert-entry-default (entry entry-type - &optional indent-level) - "Insert ENTRY of ENTRY-TYPE into the current info buffer. -If INDENT-LEVEL is non-nil, indent displayed information by this -number of `guix-info-indent' spaces." - (let ((region-beg (point))) - (mapc (lambda (param) - (guix-info-insert-param param entry entry-type)) - (guix-info-get-displayed-params entry-type)) - (when indent-level - (indent-rigidly region-beg (point) - (* indent-level guix-info-indent))))) - (defun guix-info-insert-entry (entry entry-type &optional indent-level) "Insert ENTRY of ENTRY-TYPE into the current info buffer. -Use `guix-info-insert-ENTRY-TYPE-function' or -`guix-info-insert-entry-default' if it is nil." - (let* ((var (intern (concat "guix-info-insert-" - (symbol-name entry-type) - "-function"))) - (fun (symbol-value var))) - (if (functionp fun) - (funcall fun entry) - (guix-info-insert-entry-default entry entry-type indent-level)))) - -(defun guix-info-insert-param (param entry entry-type) +If INDENT-LEVEL is non-nil, indent displayed data by this number +of `guix-info-indent' spaces." + (guix-with-indent (* (or indent-level 0) + guix-info-indent) + (dolist (spec (guix-info-format entry-type)) + (guix-info-insert-entry-unit spec entry entry-type)))) + +(defun guix-info-insert-entry-unit (format-spec entry entry-type) "Insert title and value of a PARAM at point. ENTRY is alist with parameters and their values. ENTRY-TYPE is a type of ENTRY." - (let ((val (guix-assq-value entry param))) - (unless (and guix-info-ignore-empty-vals (null val)) - (let* ((title (guix-get-param-title entry-type param)) - (insert-methods (guix-info-get-insert-methods entry-type param)) - (val-method (car insert-methods)) - (title-method (cadr insert-methods))) - (guix-info-method-funcall title title-method - #'guix-info-insert-title-default) - (guix-info-method-funcall val val-method - #'guix-info-insert-val-default - entry) - (insert "\n"))))) - -(defun guix-info-method-funcall (val method default-fun &rest args) - "Call METHOD or DEFAULT-FUN. - -If METHOD is a function and VAL is non-nil, call this -function by applying it to VAL and ARGS. - -If METHOD is a face, propertize inserted VAL with this face." - (cond ((or (null method) - (facep method)) - (funcall default-fun val method)) - ((functionp method) - (apply method val args)) - (t (error "Unknown method '%S'" method)))) - -(defun guix-info-insert-title-default (title &optional face format) - "Insert TITLE formatted with `guix-info-param-title-format' at point." + (pcase format-spec + ((pred functionp) + (funcall format-spec entry) + (insert "\n")) + (`(,param ,title-method ,value-method) + (let ((value (guix-entry-value entry param))) + (unless (and guix-info-ignore-empty-values (null value)) + (let ((title (guix-info-param-title entry-type param)) + (insert-title (guix-info-title-method->function title-method)) + (insert-value (guix-info-value-method->function value-method))) + (funcall insert-title title) + (funcall insert-value value entry) + (insert "\n"))))) + (_ (error "Unknown format specification '%S'" format-spec)))) + +(defun guix-info-insert-title-simple (title &optional face) + "Insert \"TITLE: \" string at point. +If FACE is nil, use `guix-info-param-title'." (guix-format-insert title (or face 'guix-info-param-title) - (or format guix-info-param-title-format))) + "%s: ")) -(defun guix-info-insert-title-simple (title &optional face) - "Insert TITLE at point." - (guix-info-insert-title-default title face "%s:")) - -(defun guix-info-insert-val-default (val &optional face) - "Format and insert parameter value VAL at point. - -This function is intended to be called after -`guix-info-insert-title-default'. - -If VAL is a one-line string longer than `guix-info-fill-column', -split it into several short lines. See also -`guix-info-multiline-prefix'. - -If FACE is non-nil, propertize inserted line(s) with this FACE." - (guix-split-insert val face - guix-info-fill-column - (concat "\n" guix-info-multiline-prefix))) - -(defun guix-info-insert-val-simple (val &optional face-or-fun) - "Format and insert parameter value VAL at point. - -This function is intended to be called after -`guix-info-insert-title-simple'. - -If VAL is a one-line string longer than `guix-info-fill-column', -split it into several short lines and indent each line with -`guix-info-indent' spaces. - -If FACE-OR-FUN is a face, propertize inserted line(s) with this FACE. - -If FACE-OR-FUN is a function, call it with VAL as argument. If -VAL is a list, call the function on each element of this list." - (if (null val) - (progn (guix-info-insert-indent) - (guix-format-insert nil)) - (let ((prefix (concat "\n" (guix-info-get-indent)))) - (insert prefix) - (if (functionp face-or-fun) - (guix-mapinsert face-or-fun - (if (listp val) val (list val)) - prefix) - (guix-split-insert val face-or-fun - guix-info-fill-column prefix))))) - -(defun guix-info-insert-time (seconds &optional _) +(defun guix-info-insert-title-format (title &optional face) + "Insert TITLE using `guix-info-param-title-format' at point. +If FACE is nil, use `guix-info-param-title'." + (guix-format-insert title + (or face 'guix-info-param-title) + guix-info-param-title-format)) + +(defun guix-info-insert-value-simple (value &optional button-or-face indent) + "Format and insert parameter VALUE at point. + +VALUE may be split into several short lines to fit the current +window, depending on `guix-info-fill', and each line is indented +with INDENT number of spaces. + +If BUTTON-OR-FACE is a button type symbol, transform VALUE into +this (these) button(s) and insert each one on a new line. If it +is a face symbol, propertize inserted line(s) with this face." + (or indent (setq indent 0)) + (guix-with-indent indent + (let* ((button? (guix-button-type? button-or-face)) + (face (unless button? button-or-face)) + (fill-col (unless (or button? + (and (stringp value) + (not guix-info-fill))) + (- (guix-info-fill-column) indent))) + (value (if (and value button?) + (guix-buttonize value button-or-face "\n") + value))) + (guix-split-insert value face fill-col "\n")))) + +(defun guix-info-insert-value-indent (value &optional button-or-face) + "Format and insert parameter VALUE at point. + +This function is intended to be called after inserting a title +with `guix-info-insert-title-simple'. + +VALUE may be split into several short lines to fit the current +window, depending on `guix-info-fill', and each line is indented +with `guix-info-indent'. + +For the meaning of BUTTON-OR-FACE, see `guix-info-insert-value-simple'." + (when value (insert "\n")) + (guix-info-insert-value-simple value button-or-face guix-info-indent)) + +(defun guix-info-insert-value-format (value &optional button-or-face + &rest button-properties) + "Format and insert parameter VALUE at point. + +This function is intended to be called after inserting a title +with `guix-info-insert-title-format'. + +VALUE may be split into several short lines to fit the current +window, depending on `guix-info-fill' and +`guix-info-multiline-prefix'. If VALUE is a list, its elements +will be separated with `guix-list-separator'. + +If BUTTON-OR-FACE is a button type symbol, transform VALUE into +this (these) button(s). If it is a face symbol, propertize +inserted line(s) with this face. + +BUTTON-PROPERTIES are passed to `guix-buttonize' (only if +BUTTON-OR-FACE is a button type)." + (let* ((button? (guix-button-type? button-or-face)) + (face (unless button? button-or-face)) + (fill-col (when (or button? + guix-info-fill + (not (stringp value))) + (- (guix-info-fill-column) + (length guix-info-multiline-prefix)))) + (value (if (and value button?) + (apply #'guix-buttonize + value button-or-face guix-list-separator + button-properties) + value))) + (guix-split-insert value face fill-col + (concat "\n" guix-info-multiline-prefix)))) + +(defun guix-info-insert-time (seconds &optional face) "Insert formatted time string using SECONDS at point." - (guix-info-insert-val-default (guix-get-time-string seconds) - 'guix-info-time)) + (guix-format-insert (guix-get-time-string seconds) + (or face 'guix-info-time))) ;;; Buttons @@ -359,21 +349,6 @@ VAL is a list, call the function on each element of this list." '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." @@ -395,496 +370,112 @@ See `insert-text-button' for the meaning of PROPERTIES." 'help-echo message properties)) -(defun guix-info-insert-file-path (path &optional _) - "Make button from file PATH and insert it at point." - (guix-insert-button path 'guix-file)) - -(defun guix-info-insert-url (url &optional _) - "Make button from URL and insert it at point." - (guix-insert-button url 'guix-url)) - +;;; Major mode and interface definer + (defvar guix-info-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent - map (make-composed-keymap (list guix-root-map button-buffer-map) + map (make-composed-keymap (list guix-buffer-map button-buffer-map) special-mode-map)) map) - "Parent keymap for info buffers.") + "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. +Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... + +Required keywords: + + - `:format' - default value of the generated + `guix-ENTRY-TYPE-info-format' variable. + +The rest keyword arguments are passed to +`guix-buffer-define-interface' macro." + (declare (indent 1)) + (let* ((entry-type-str (symbol-name entry-type)) + (prefix (concat "guix-" entry-type-str "-info")) + (group (intern prefix)) + (format-var (intern (concat prefix "-format")))) + (guix-keyword-args-let args + ((show-entries-val :show-entries-function) + (format-val :format)) + `(progn + (defcustom ,format-var ,format-val + ,(format "\ +List of methods for inserting '%s' entry. +Each METHOD should be either a function or should have the +following form: + + (PARAM INSERT-TITLE INSERT-VALUE) + +If METHOD is a function, it is called with an entry as argument. + +PARAM is a name of '%s' entry parameter. + +INSERT-TITLE may be either a symbol or a list. If it is a +symbol, it should be a function or an alias from +`guix-info-title-aliases', in which case it is called with title +as argument. If it is a list, it should have a +form (FUN-OR-ALIAS [ARGS ...]), in which case FUN-OR-ALIAS is +called with title and ARGS as arguments. + +INSERT-VALUE may be either a symbol or a list. If it is a +symbol, it should be a function or an alias from +`guix-info-value-aliases', in which case it is called with value +and entry as arguments. If it is a list, it should have a +form (FUN-OR-ALIAS [ARGS ...]), in which case FUN-OR-ALIAS is +called with value and ARGS as arguments. + +Parameters are inserted in the same order as defined by this list. +After calling each METHOD, a new line is inserted." + entry-type-str entry-type-str) + :type 'sexp + :group ',group) + + (guix-alist-put! + '((format . ,format-var)) + 'guix-info-data ',entry-type) + + ,(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)))))))) -;;; Displaying packages - -(guix-define-buffer-type info package - :required (id installed non-unique)) - -(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) +(defvar guix-info-font-lock-keywords + (eval-when-compile + `((,(rx "(" (group "guix-info-define-interface") + symbol-end) + . 1)))) -(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) - -(defvar guix-info-insert-package-function - #'guix-package-info-insert-with-heading - "Function used to insert a package information. -It is called with a single argument - alist of package parameters. -If nil, insert package in a default way.") - -(defvar guix-package-info-heading-params '(synopsis description) - "List of parameters displayed in a heading along with name and version.") - -(defcustom guix-package-info-fill-heading t - "If nil, insert heading parameters in a raw form, without -filling them to fit the window." - :type 'boolean - :group 'guix-package-info) - -(defun guix-package-info-insert-heading (entry) - "Insert the heading for package ENTRY. -Show package name, version, and `guix-package-info-heading-params'." - (guix-format-insert (concat (guix-assq-value entry 'name) " " - (guix-assq-value entry 'version)) - 'guix-package-info-heading) - (insert "\n\n") - (mapc (lambda (param) - (let ((val (guix-assq-value entry param)) - (face (guix-get-symbol (symbol-name param) - 'info 'package))) - (when val - (let* ((col (min (window-width) fill-column)) - (val (if guix-package-info-fill-heading - (guix-get-filled-string val col) - val))) - (guix-format-insert val (and (facep face) face)) - (insert "\n\n"))))) - guix-package-info-heading-params)) - -(defun guix-package-info-insert-with-heading (entry) - "Insert package ENTRY with its heading at point." - (guix-package-info-insert-heading entry) - (mapc (lambda (param) - (unless (or (memq param '(name version)) - (memq param guix-package-info-heading-params)) - (guix-info-insert-param param entry 'package))) - (guix-info-get-displayed-params 'package))) - -(defun guix-package-info-insert-description (desc &optional _) - "Insert description DESC at point." - (guix-info-insert-val-simple desc 'guix-package-info-description)) - -(defun guix-package-info-insert-location (location &optional _) - "Make button from file LOCATION and insert it at point." - (guix-insert-button location 'guix-package-location)) - -(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"))) - (fun (intern (concat "guix-package-info-insert-" type-name "inputs")))) - `(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) - - (defun ,fun (inputs &optional _) - ,(concat "Make buttons from " type-desc "INPUTS and insert them at point.") - (guix-package-info-insert-full-names inputs ',btn))))) - -(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-full-names (names button-type) - "Make BUTTON-TYPE buttons from package NAMES and insert them at point. -NAMES is a list of strings." - (if names - (guix-info-insert-val-default - (with-temp-buffer - (guix-mapinsert (lambda (name) - (guix-insert-button name button-type)) - names - guix-list-separator) - (buffer-substring (point-min) (point-max)))) - (guix-format-insert nil))) - - -;;; 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.") - -(defvar guix-info-insert-installed-function nil - "Function used to insert an installed information. -It is called with a single argument - alist of installed -parameters (`output', `path', `dependencies'). -If nil, insert installed info in a default way.") - -(defun guix-package-info-insert-outputs (outputs entry) - "Insert OUTPUTS from package ENTRY at point." - (and (guix-assq-value entry 'obsolete) - (guix-package-info-insert-obsolete-text)) - (and (guix-assq-value entry 'non-unique) - (guix-assq-value entry 'installed) - (guix-package-info-insert-non-unique-text - (guix-get-full-name 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-assq-value entry 'installed)) - (obsolete (guix-assq-value entry 'obsolete)) - (installed-entry (cl-find-if - (lambda (entry) - (string= (guix-assq-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 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-get-full-name 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-assq-value entry 'package-id) - (guix-assq-value entry 'id)) - 'output output))) - -(defun guix-package-info-insert-output-path (path &optional _) - "Insert PATH of the installed output." - (guix-info-insert-val-simple path #'guix-info-insert-file-path)) - -(defalias 'guix-package-info-insert-output-dependencies - 'guix-package-info-insert-output-path) - - -;;; 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-insert-source-url (url &optional _) - "Make button from source URL and insert it at point." - (guix-insert-button url 'guix-package-source)) - -(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* ((entry (guix-get-entry-by-id entry-id guix-entries)) - (file (guix-package-source-path package-id))) - (or file - (error "Couldn't define file path of the package source")) - (let* ((new-entry (cons (cons 'source-file file) - entry)) - (entries (cl-substitute-if - new-entry - (lambda (entry) - (equal (guix-assq-value entry 'id) - entry-id)) - guix-entries - :count 1))) - (guix-redisplay-buffer :entries entries) - (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." - (guix-info-insert-indent) - (if (null source) - (guix-format-insert nil) - (let* ((source-file (guix-assq-value entry 'source-file)) - (entry-id (guix-assq-value entry 'id)) - (package-id (or (guix-assq-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 path 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-val-simple source-file - #'guix-info-insert-file-path)) - (guix-info-insert-val-simple source - #'guix-package-info-insert-source-url)))) - -(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) - (guix-redisplay-buffer :buffer guix-package-info-download-buffer) - (setq guix-package-info-download-buffer nil))) - -(add-hook 'guix-after-source-download-hook - 'guix-package-info-redisplay-after-download) - - -;;; Displaying outputs - -(guix-define-buffer-type info output - :buffer-name "*Guix Package Info*" - :required (id package-id installed non-unique)) - -(defvar guix-info-insert-output-function nil - "Function used to insert an output information. -It is called with a single argument - alist of output parameters. -If nil, insert output in a default way.") - -(defun guix-output-info-insert-version (version entry) - "Insert output VERSION and obsolete text if needed at point." - (guix-info-insert-val-default version - 'guix-package-info-version) - (and (guix-assq-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-assq-value entry 'installed)) - (obsolete (guix-assq-value entry 'obsolete)) - (action-type (if installed 'delete 'install))) - (guix-info-insert-val-default - 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-define-buffer-type info generation) - -(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) - -(defvar guix-info-insert-generation-function nil - "Function used to insert a generation information. -It is called with a single argument - alist of generation parameters. -If nil, insert generation in a default way.") - -(defun guix-generation-info-insert-number (number &optional _) - "Insert generation NUMBER and action buttons." - (guix-info-insert-val-default 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-val-default "Yes" 'guix-generation-info-current) - (guix-info-insert-val-default "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-assq-value entry 'number)))) +(font-lock-add-keywords 'emacs-lisp-mode guix-info-font-lock-keywords) (provide 'guix-info) |