me/guix
Archived
1
0
Fork 0
Code Activity

emacs: info: Generalize inserting and formatting.

Browse source 
* emacs/guix-info.el: Use a more flexible format for inserting any data.
  (guix-info-ignore-empty-vals): Rename to...
  (guix-info-ignore-empty-values): ... this.
  (guix-info-insert-methods): Merge this and...
  (guix-info-displayed-params): ... this into...
  (guix-info-format): ... this.  Change format specifications.
  (guix-info-title-aliases, guix-info-value-aliases): New variables.
  (guix-info-displayed-params): Adjust for the new format.
  (guix-info-insert-entry): Likewise.
  (guix-package-info-fill-heading): Replace with...
  (guix-info-fill): ... this.
  (guix-info-insert-param): Replace with...
  (guix-info-insert-entry-unit): ... this.
  (guix-info-insert-title-default): Replace with...
  (guix-info-insert-title-format): ... this.
  (guix-info-insert-val-default): Replace with...
  (guix-info-insert-value-format): ... this.
  (guix-info-insert-val-simple): Replace with...
  (guix-info-insert-value-indent): ... this.
  (guix-package-info-insert-source): Adjust accordingly.
  (guix-package-info-insert-heading): Insert only name and version.
  (guix-package-info-define-insert-inputs): Do not generate
  'guix-package-info-insert-ENTRY-TYPE-inputs' procedures.
  (guix-info-fill-column, guix-info-insert-entry-default)
  (guix-info-method-funcall, guix-info-insert-file-path)
  (guix-info-insert-url, guix-info-insert-package-function)
  (guix-info-insert-installed-function)
  (guix-info-insert-output-function)
  (guix-info-insert-generation-function)
  (guix-package-info-heading-params)
  (guix-package-info-insert-with-heading)
  (guix-package-info-insert-description)
  (guix-package-info-insert-location)
  (guix-package-info-insert-full-names)
  (guix-package-info-insert-source-url): Remove.
  (guix-info-fill-column, guix-info-param-title)
  (guix-info-title-function, guix-info-value-function)
  (guix-info-title-method->function)
  (guix-info-value-method->function)
  (guix-info-insert-value-simple): New procedures.
* emacs/guix-utils.el (guix-buttonize, guix-button-type?): New
  procedures.
  (guix-split-string): Split multi-line strings and ignore empty lines.
* doc/emacs.texi (Emacs Appearance): Adjust accordingly.
This commit is contained in:
Alex Kost 2015-11-20 00:13:19 +03:00
parent 25d2fe8bef
commit 2c7ed388cf
3 changed files with 277 additions and 301 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
doc/emacs.texi
View file

@ -484,13 +484,12 @@ the following variables (@dfn{ENTRY-TYPE} means @code{package},
Specify the columns, their names, what and how is displayed in ``list'' Specify the columns, their names, what and how is displayed in ``list''
buffers. buffers.
@item guix-info-displayed-params @item guix-info-format
@itemx guix-info-insert-methods @itemx guix-info-ignore-empty-values
@itemx guix-info-ignore-empty-vals
@itemx guix-info-param-title-format @itemx guix-info-param-title-format
@itemx guix-info-multiline-prefix @itemx guix-info-multiline-prefix
@itemx guix-info-indent @itemx guix-info-indent
@itemx guix-info-fill-column @itemx guix-info-fill
@itemx guix-info-delimiter @itemx guix-info-delimiter
Various settings for ``info'' buffers. Various settings for ``info'' buffers.

536
emacs/guix-info.el
View file

@ -81,122 +81,175 @@
"Mouse face used for action buttons." "Mouse face used for action buttons."
:group 'guix-info-faces) :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." "If non-nil, do not display parameters with nil values."
:type 'boolean :type 'boolean
:group 'guix-info) :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: " (defvar guix-info-param-title-format "%-18s: "
"String used to format a title of a parameter. "String used to format a title of a parameter.
It should be a '%s'-sequence. After inserting a title formatted It should be a '%s'-sequence. After inserting a title formatted
with this string, a value of the parameter is inserted. 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. "String used to format multi-line parameter values.
If a value occupies more than one line, this string is inserted If a value occupies more than one line, this string is inserted
in the beginning of each line after the first one. 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 (defvar guix-info-indent 2
"Number of spaces used to indent various parts of inserted text.") "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" (defvar guix-info-delimiter "\n\f\n"
"String used to separate entries.") "String used to separate entries.")
(defvar guix-info-insert-methods (defvar guix-info-format
'((package '((package
(name guix-package-info-name) guix-package-info-insert-heading
(version guix-package-info-version) ignore
(license guix-package-info-license) (synopsis ignore (simple guix-package-info-synopsis))
(synopsis guix-package-info-synopsis) ignore
(description guix-package-info-insert-description (description ignore (simple guix-package-info-description))
guix-info-insert-title-simple) ignore
(outputs guix-package-info-insert-outputs (outputs simple guix-package-info-insert-outputs)
guix-info-insert-title-simple) (source simple guix-package-info-insert-source)
(source guix-package-info-insert-source (location format (format guix-package-location))
guix-info-insert-title-simple) (home-url format (format guix-url))
(home-url guix-info-insert-url) (license format (format guix-package-info-license))
(inputs guix-package-info-insert-inputs) (inputs format (format guix-package-input))
(native-inputs guix-package-info-insert-native-inputs) (native-inputs format (format guix-package-native-input))
(propagated-inputs guix-package-info-insert-propagated-inputs) (propagated-inputs format (format guix-package-propagated-input)))
(location guix-package-info-insert-location))
(installed (installed
(path guix-package-info-insert-output-path (path simple (indent guix-file))
guix-info-insert-title-simple) (dependencies simple (indent guix-file)))
(dependencies guix-package-info-insert-output-dependencies
guix-info-insert-title-simple))
(output (output
(name guix-package-info-name) (name format (format guix-package-info-name))
(version guix-output-info-insert-version) (version format guix-output-info-insert-version)
(output guix-output-info-insert-output) (output format guix-output-info-insert-output)
(source guix-package-info-insert-source (synopsis simple (indent guix-package-info-synopsis))
guix-info-insert-title-simple) (source simple guix-package-info-insert-source)
(path guix-package-info-insert-output-path (path simple (indent guix-file))
guix-info-insert-title-simple) (dependencies simple (indent guix-file))
(dependencies guix-package-info-insert-output-dependencies (location format (format guix-package-location))
guix-info-insert-title-simple) (home-url format (format guix-url))
(license guix-package-info-license) (license format (format guix-package-info-license))
(synopsis guix-package-info-synopsis) (inputs format (format guix-package-input))
(description guix-package-info-insert-description (native-inputs format (format guix-package-native-input))
guix-info-insert-title-simple) (propagated-inputs format (format guix-package-propagated-input))
(home-url guix-info-insert-url) (description simple (indent guix-package-info-description)))
(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 (generation
(number guix-generation-info-insert-number) (number format guix-generation-info-insert-number)
(current guix-generation-info-insert-current) (prev-number format (format))
(path guix-info-insert-file-path) (current format guix-generation-info-insert-current)
(time guix-info-insert-time))) (path simple (indent guix-file))
(time format (time))))
"Methods for inserting parameter values. "Methods for inserting parameter values.
Each element of the list should have a form: Each element of the list should have a form:
(ENTRY-TYPE . ((PARAM INSERT-VALUE [INSERT-TITLE]) ...)) (ENTRY-TYPE . (METHOD ...))
INSERT-VALUE may be either nil, a face name or a function. If it Each METHOD should be either a function or should have the
is nil or a face, `guix-info-insert-val-default' function is following form:
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 (PARAM INSERT-TITLE INSERT-VALUE)
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 If METHOD is a function, it is called with an entry as argument.
'((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 ...)) PARAM is a name of entry parameter.
The order of displayed parameters is the same as in this list.") 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.
(defun guix-info-insert-methods (entry-type param) INSERT-VALUE may be either a symbol or a list. If it is a
"Return list of insert methods for parameter PARAM of ENTRY-TYPE. symbol, it should be a function or an alias from
See `guix-info-insert-methods' for details." `guix-info-value-aliases', in which case it is called with value
(guix-assq-value guix-info-insert-methods and entry as arguments. If it is a list, it should have a
entry-type param)) 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.")
(defun guix-info-param-title (entry-type param)
"Return a title of an ENTRY-TYPE parameter PARAM."
(guix-get-param-title entry-type param))
(defun guix-info-format (entry-type)
"Return 'info' format for ENTRY-TYPE."
(guix-assq-value guix-info-format entry-type))
(defun guix-info-displayed-params (entry-type) (defun guix-info-displayed-params (entry-type)
"Return parameters of ENTRY-TYPE that should be displayed." "Return a list of ENTRY-TYPE parameters that should be displayed."
(guix-assq-value guix-info-displayed-params (delq nil
entry-type)) (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) (defun guix-info-get-indent (&optional level)
"Return `guix-info-indent' \"multiplied\" by LEVEL spaces. "Return `guix-info-indent' \"multiplied\" by LEVEL spaces.
@ -215,115 +268,122 @@ ENTRIES should have a form of `guix-entries'."
entries entries
guix-info-delimiter)) 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."
(guix-with-indent (* (or indent-level 0)
guix-info-indent)
(mapc (lambda (param)
(guix-info-insert-param param entry entry-type))
(guix-info-displayed-params entry-type))))
(defun guix-info-insert-entry (entry entry-type &optional indent-level) (defun guix-info-insert-entry (entry entry-type &optional indent-level)
"Insert ENTRY of ENTRY-TYPE into the current info buffer. "Insert ENTRY of ENTRY-TYPE into the current info buffer.
Use `guix-info-insert-ENTRY-TYPE-function' or If INDENT-LEVEL is non-nil, indent displayed data by this number
`guix-info-insert-entry-default' if it is nil." of `guix-info-indent' spaces."
(let* ((var (intern (concat "guix-info-insert-" (guix-with-indent (* (or indent-level 0)
(symbol-name entry-type) guix-info-indent)
"-function"))) (dolist (spec (guix-info-format entry-type))
(fun (symbol-value var))) (guix-info-insert-entry-unit spec entry entry-type))))
(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) (defun guix-info-insert-entry-unit (format-spec entry entry-type)
"Insert title and value of a PARAM at point. "Insert title and value of a PARAM at point.
ENTRY is alist with parameters and their values. ENTRY is alist with parameters and their values.
ENTRY-TYPE is a type of ENTRY." ENTRY-TYPE is a type of ENTRY."
(let ((val (guix-entry-value entry param))) (pcase format-spec
(unless (and guix-info-ignore-empty-vals (null val)) ((pred functionp)
(let* ((title (guix-get-param-title entry-type param)) (funcall format-spec entry)
(insert-methods (guix-info-insert-methods entry-type param)) (insert "\n"))
(val-method (car insert-methods)) (`(,param ,title-method ,value-method)
(title-method (cadr insert-methods))) (let ((value (guix-entry-value entry param)))
(guix-info-method-funcall title title-method (unless (and guix-info-ignore-empty-values (null value))
#'guix-info-insert-title-default) (let ((title (guix-info-param-title entry-type param))
(guix-info-method-funcall val val-method (insert-title (guix-info-title-method->function title-method))
#'guix-info-insert-val-default (insert-value (guix-info-value-method->function value-method)))
entry) (funcall insert-title title)
(insert "\n"))))) (funcall insert-value value entry)
(insert "\n")))))
(defun guix-info-method-funcall (val method default-fun &rest args) (_ (error "Unknown format specification '%S'" format-spec))))
"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."
(guix-format-insert title
(or face 'guix-info-param-title)
(or format guix-info-param-title-format)))
(defun guix-info-insert-title-simple (title &optional face) (defun guix-info-insert-title-simple (title &optional face)
"Insert TITLE at point." "Insert \"TITLE: \" string at point.
(guix-info-insert-title-default title face "%s:")) If FACE is nil, use `guix-info-param-title'."
(guix-format-insert title
(or face 'guix-info-param-title)
"%s: "))
(defun guix-info-insert-val-default (val &optional face) (defun guix-info-insert-title-format (title &optional face)
"Format and insert parameter value VAL at point. "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))
This function is intended to be called after (defun guix-info-insert-value-simple (value &optional button-or-face indent)
`guix-info-insert-title-default'. "Format and insert parameter VALUE at point.
If VAL is a one-line string longer than `guix-info-fill-column', VALUE may be split into several short lines to fit the current
split it into several short lines. See also window, depending on `guix-info-fill', and each line is indented
`guix-info-multiline-prefix'. with INDENT number of spaces.
If FACE is non-nil, propertize inserted line(s) with this FACE." If BUTTON-OR-FACE is a button type symbol, transform VALUE into
(guix-split-insert val face this (these) button(s) and insert each one on a new line. If it
guix-info-fill-column is a face symbol, propertize inserted line(s) with this face."
(concat "\n" guix-info-multiline-prefix))) (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-val-simple (val &optional face-or-fun) (defun guix-info-insert-value-indent (value &optional button-or-face)
"Format and insert parameter value VAL at point. "Format and insert parameter VALUE at point.
This function is intended to be called after This function is intended to be called after inserting a title
`guix-info-insert-title-simple'. with `guix-info-insert-title-simple'.
If VAL is a one-line string longer than `guix-info-fill-column', VALUE may be split into several short lines to fit the current
split it into several short lines and indent each line with window, depending on `guix-info-fill', and each line is indented
`guix-info-indent' spaces. with `guix-info-indent'.
If FACE-OR-FUN is a face, propertize inserted line(s) with this FACE. 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))
If FACE-OR-FUN is a function, call it with VAL as argument. If (defun guix-info-insert-value-format (value &optional button-or-face
VAL is a list, call the function on each element of this list." &rest button-properties)
(if (null val) "Format and insert parameter VALUE at point.
(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 _) 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." "Insert formatted time string using SECONDS at point."
(guix-info-insert-val-default (guix-get-time-string seconds) (guix-format-insert (guix-get-time-string seconds)
'guix-info-time)) (or face 'guix-info-time)))
;;; Buttons ;;; Buttons
@ -394,14 +454,6 @@ See `insert-text-button' for the meaning of PROPERTIES."
'help-echo message 'help-echo message
properties)) 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))
(defvar guix-info-mode-map (defvar guix-info-mode-map
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
@ -418,7 +470,7 @@ See `insert-text-button' for the meaning of PROPERTIES."
;;; Displaying packages ;;; Displaying packages
(guix-define-buffer-type info package (guix-define-buffer-type info package
:required (id installed non-unique)) :required (id name version installed non-unique))
(defface guix-package-info-heading (defface guix-package-info-heading
'((t :inherit guix-info-heading)) '((t :inherit guix-info-heading))
@ -483,57 +535,11 @@ See `insert-text-button' for the meaning of PROPERTIES."
"Face used if a package is obsolete." "Face used if a package is obsolete."
:group 'guix-package-info-faces) :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) (defun guix-package-info-insert-heading (entry)
"Insert the heading for package ENTRY. "Insert package ENTRY heading (name specification) at point."
Show package name, version, and `guix-package-info-heading-params'."
(guix-format-insert (concat (guix-entry-value entry 'name) " " (guix-format-insert (concat (guix-entry-value entry 'name) " "
(guix-entry-value entry 'version)) (guix-entry-value entry 'version))
'guix-package-info-heading) 'guix-package-info-heading))
(insert "\n\n")
(mapc (lambda (param)
(let ((val (guix-entry-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-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) (defmacro guix-package-info-define-insert-inputs (&optional type)
"Define a face and a function for inserting package inputs. "Define a face and a function for inserting package inputs.
@ -544,8 +550,7 @@ Face name is `guix-package-info-TYPE-inputs'."
(type-name (and type (concat type-str "-"))) (type-name (and type (concat type-str "-")))
(type-desc (and type (concat type-str " "))) (type-desc (and type (concat type-str " ")))
(face (intern (concat "guix-package-info-" type-name "inputs"))) (face (intern (concat "guix-package-info-" type-name "inputs")))
(btn (intern (concat "guix-package-" type-name "input"))) (btn (intern (concat "guix-package-" type-name "input"))))
(fun (intern (concat "guix-package-info-insert-" type-name "inputs"))))
`(progn `(progn
(defface ,face (defface ,face
'((t :inherit guix-package-info-name-button)) '((t :inherit guix-package-info-name-button))
@ -554,29 +559,12 @@ Face name is `guix-package-info-TYPE-inputs'."
(define-button-type ',btn (define-button-type ',btn
:supertype 'guix-package-name :supertype 'guix-package-name
'face ',face) '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)
(guix-package-info-define-insert-inputs native) (guix-package-info-define-insert-inputs native)
(guix-package-info-define-insert-inputs propagated) (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 ;;; Inserting outputs and installed parameters
@ -588,12 +576,6 @@ formatted with this string, an action button is inserted.")
(defvar guix-package-info-obsolete-string "(This package is obsolete)" (defvar guix-package-info-obsolete-string "(This package is obsolete)"
"String used if a 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) (defun guix-package-info-insert-outputs (outputs entry)
"Insert OUTPUTS from package ENTRY at point." "Insert OUTPUTS from package ENTRY at point."
(and (guix-entry-value entry 'obsolete) (and (guix-entry-value entry 'obsolete)
@ -668,13 +650,6 @@ ENTRY is an alist with package info."
(guix-entry-id entry)) (guix-entry-id entry))
'output output))) '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 ;;; Inserting a source
@ -711,10 +686,6 @@ prompt depending on `guix-operation-confirm' variable)."
;; no action is bound to a source button. ;; no action is bound to a source button.
(message "Yes, this is the source URL. What did you expect?"))) (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) (defun guix-package-info-show-source (entry-id package-id)
"Show file name of a package source in the current info buffer. "Show file name of a package source in the current info buffer.
Find the file if needed (see `guix-package-info-auto-find-source'). Find the file if needed (see `guix-package-info-auto-find-source').
@ -746,7 +717,6 @@ PACKAGE-ID is an ID of the package which source to show."
(defun guix-package-info-insert-source (source entry) (defun guix-package-info-insert-source (source entry)
"Insert SOURCE from package ENTRY at point. "Insert SOURCE from package ENTRY at point.
SOURCE is a list of URLs." SOURCE is a list of URLs."
(guix-info-insert-indent)
(if (null source) (if (null source)
(guix-format-insert nil) (guix-format-insert nil)
(let* ((source-file (guix-entry-value entry 'source-file)) (let* ((source-file (guix-entry-value entry 'source-file))
@ -759,7 +729,7 @@ SOURCE is a list of URLs."
(lambda (btn) (lambda (btn)
(guix-package-info-show-source (button-get btn 'entry-id) (guix-package-info-show-source (button-get btn 'entry-id)
(button-get btn 'package-id))) (button-get btn 'package-id)))
"Show the source store path of the current package" "Show the source store directory of the current package"
'entry-id entry-id 'entry-id entry-id
'package-id package-id) 'package-id package-id)
(unless (file-exists-p source-file) (unless (file-exists-p source-file)
@ -770,10 +740,8 @@ SOURCE is a list of URLs."
(button-get btn 'package-id))) (button-get btn 'package-id)))
"Download the source into the store" "Download the source into the store"
'package-id package-id)) 'package-id package-id))
(guix-info-insert-val-simple source-file (guix-info-insert-value-indent source-file 'guix-file))
#'guix-info-insert-file-path)) (guix-info-insert-value-indent source 'guix-package-source))))
(guix-info-insert-val-simple source
#'guix-package-info-insert-source-url))))
(defun guix-package-info-redisplay-after-download () (defun guix-package-info-redisplay-after-download ()
"Redisplay an 'info' buffer after downloading the package source. "Redisplay an 'info' buffer after downloading the package source.
@ -788,19 +756,14 @@ This function is used to hide a \"Download\" button if needed."
;;; Displaying outputs ;;; Displaying outputs
(guix-define-buffer-type info output (guix-ui-info-define-interface output
:buffer-name "*Guix Package Info*" :buffer-name "*Guix Package Info*"
:required (id package-id installed non-unique)) :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) (defun guix-output-info-insert-version (version entry)
"Insert output VERSION and obsolete text if needed at point." "Insert output VERSION and obsolete text if needed at point."
(guix-info-insert-val-default version (guix-info-insert-value-format version
'guix-package-info-version) 'guix-package-info-version)
(and (guix-entry-value entry 'obsolete) (and (guix-entry-value entry 'obsolete)
(guix-package-info-insert-obsolete-text))) (guix-package-info-insert-obsolete-text)))
@ -809,7 +772,7 @@ If nil, insert output in a default way.")
(let* ((installed (guix-entry-value entry 'installed)) (let* ((installed (guix-entry-value entry 'installed))
(obsolete (guix-entry-value entry 'obsolete)) (obsolete (guix-entry-value entry 'obsolete))
(action-type (if installed 'delete 'install))) (action-type (if installed 'delete 'install)))
(guix-info-insert-val-default (guix-info-insert-value-format
output output
(if installed (if installed
'guix-package-info-installed-outputs 'guix-package-info-installed-outputs
@ -840,14 +803,9 @@ If nil, insert output in a default way.")
"Face used if a generation is not the current one." "Face used if a generation is not the current one."
:group 'guix-generation-info-faces) :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 _) (defun guix-generation-info-insert-number (number &optional _)
"Insert generation NUMBER and action buttons." "Insert generation NUMBER and action buttons."
(guix-info-insert-val-default number 'guix-generation-info-number) (guix-info-insert-value-format number 'guix-generation-info-number)
(guix-info-insert-indent) (guix-info-insert-indent)
(guix-info-insert-action-button (guix-info-insert-action-button
"Packages" "Packages"
@ -868,8 +826,8 @@ If nil, insert generation in a default way.")
(defun guix-generation-info-insert-current (val entry) (defun guix-generation-info-insert-current (val entry)
"Insert boolean value VAL showing whether this generation is current." "Insert boolean value VAL showing whether this generation is current."
(if val (if val
(guix-info-insert-val-default "Yes" 'guix-generation-info-current) (guix-info-insert-value-format "Yes" 'guix-generation-info-current)
(guix-info-insert-val-default "No" 'guix-generation-info-not-current) (guix-info-insert-value-format "No" 'guix-generation-info-not-current)
(guix-info-insert-indent) (guix-info-insert-indent)
(guix-info-insert-action-button (guix-info-insert-action-button
"Switch" "Switch"

35
emacs/guix-utils.el
View file

@ -104,6 +104,28 @@ See `insert-text-button' for the meaning of PROPERTIES."
:type (or type 'button) :type (or type 'button)
properties))) properties)))
(defun guix-buttonize (value button-type separator &rest properties)
"Make BUTTON-TYPE button(s) from VALUE.
Return a string with button(s).
VALUE should be a string or a list of strings. If it is a list
of strings, buttons are separated with SEPARATOR string.
PROPERTIES are passed to `guix-insert-button'."
(with-temp-buffer
(let ((labels (if (listp value) value (list value))))
(guix-mapinsert (lambda (label)
(apply #'guix-insert-button
label button-type properties))
labels
separator))
(buffer-substring (point-min) (point-max))))
(defun guix-button-type? (symbol)
"Return non-nil, if SYMBOL is a button type."
(and symbol
(get symbol 'button-category-symbol)))
(defun guix-split-insert (val &optional face col separator) (defun guix-split-insert (val &optional face col separator)
"Convert VAL into a string, split it and insert at point. "Convert VAL into a string, split it and insert at point.
@ -122,14 +144,11 @@ Separate inserted lines with SEPARATOR."
(defun guix-split-string (str &optional col) (defun guix-split-string (str &optional col)
"Split string STR by lines and return list of result strings. "Split string STR by lines and return list of result strings.
If COL is non-nil and STR is a one-line string longer than COL, If COL is non-nil, fill STR to this column."
split it into several short lines." (let ((str (if col
(let ((strings (split-string str "\n *"))) (guix-get-filled-string str col)
(if (and col str)))
(null (cdr strings)) ; if not multi-line (split-string str "\n *" t)))
(> (length str) col))
(split-string (guix-get-filled-string str col) "\n")
strings)))
(defun guix-get-filled-string (str col) (defun guix-get-filled-string (str col)
"Return string by filling STR to column COL." "Return string by filling STR to column COL."