* configure.ac (emacsuidir): New variable.
(AC_CONFIG_FILES): Add 'emacs/guix-init.el', 'emacs/guix-helper.scm'.
* Makefile.am: Include 'emacs.am'.
* emacs.am: New file.
* doc/emacs.texi: New file.
* doc/guix.texi: Include 'emacs.texi'.
* emacs/guix-backend.el: New file.
* emacs/guix-base.el: New file.
* emacs/guix-helper.scm.in: New file.
* emacs/guix-history.el: New file.
* emacs/guix-info.el: New file.
* emacs/guix-init.el.in: New file.
* emacs/guix-list.el: New file.
* emacs/guix-main.scm: New file.
* emacs/guix-utils.el: New file.
* emacs/guix.el: New file.
/nix-setuid-helper
/nix/scripts/guix-authenticate
/nix/scripts/offload
+/emacs/Makefile.in
+/emacs/Makefile
+/emacs/guix-autoloads.el
+/emacs/guix-helper.scm
+/emacs/guix-init.el
--with-nix-prefix="$(NIX_PREFIX)" \
--enable-daemon
+dist_emacsui_DATA = emacs/guix-main.scm
+nodist_emacsui_DATA = emacs/guix-helper.scm
+include emacs.am
+
dist-hook: sync-descriptions gen-ChangeLog assert-no-store-file-names
distcheck-hook: assert-binaries-available assert-final-inputs-self-contained
AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env])
AC_CONFIG_FILES([test-env], [chmod +x test-env])
+dnl Emacs interface.
+AM_PATH_LISPDIR
+emacsuidir="${guilemoduledir}/guix/emacs"
+AC_SUBST([emacsuidir])
+AC_CONFIG_FILES([emacs/guix-init.el
+ emacs/guix-helper.scm])
+
AC_OUTPUT
--- /dev/null
+@node Emacs Interface
+@section Emacs Interface
+
+@cindex emacs
+GNU Guix comes with a visual user interface for GNU@tie{}Emacs, known
+as ``guix.el''. It can be used for routine package management tasks,
+pretty much like the @command{guix package} command (@pxref{Invoking
+guix package}). Specifically, ``guix.el'' makes it easy to:
+
+@itemize
+@item browse and display packages and generations;
+@item search, install, upgrade and remove packages;
+@item display packages from previous generations;
+@item do some other useful things.
+@end itemize
+
+@menu
+* Initial Setup: emacs Initial Setup. Preparing @file{~/.emacs}.
+* Usage: emacs Usage. Using the interface.
+* Configuration: emacs Configuration. Configuring the interface.
+@end menu
+
+@node emacs Initial Setup
+@subsection Initial Setup
+
+To be able to use ``guix.el'', you need to install the following
+packages:
+
+@itemize
+@item
+@uref{http://www.gnu.org/software/emacs/, GNU Emacs}, version 24.3 or
+later;
+
+@item
+@uref{http://nongnu.org/geiser/, Geiser}, version 0.3 or later: it is
+used for interacting with the Guile process.
+
+@end itemize
+
+When it is done, add the following into your init file (@pxref{Init
+File,,, emacs, The Emacs Editor}):
+
+@example
+(require 'guix-init nil t)
+@end example
+
+However there is a chance that @code{load-path} of your Emacs does not
+contain a directory with ``guix.el'' (usually it is
+@file{/usr/share/emacs/site-lisp/}). In that case you need to add it
+before requiring (@pxref{Lisp Libraries,,, emacs, The Emacs Editor}):
+
+@example
+(add-to-list 'load-path "/path/to/directory-with-guix.el")
+(require 'guix-init)
+@end example
+
+Do not worry about the efficiency of that @code{require} thing. It will
+not load the whole ``guix.el'' package, it will just autoload the main
+interactive commands (@pxref{Autoload,,, elisp, Emacs Lisp}).
+
+
+@node emacs Usage
+@subsection Usage
+
+Once ``guix.el'' has been successfully configured, you should be able to
+use commands for displaying packages and generations. This information
+can be displayed in a ``list'' or ``info'' buffer.
+
+@menu
+* Commands: emacs Commands. @kbd{M-x guix-@dots{}}
+* General information: emacs General info. Common for both interfaces.
+* ``List'' buffer: emacs List buffer. List-like interface.
+* ``Info'' buffer: emacs Info buffer. Help-like interface.
+@end menu
+
+@node emacs Commands
+@subsubsection Commands
+
+You may use the following commands to display packages and generations:
+
+@table @kbd
+@item M-x guix-all-available-packages
+@itemx M-x guix-newest-available-packages
+Display all/newest available packages.
+
+@item M-x guix-installed-packages
+Display all packages installed in the current profile.
+
+@item M-x guix-obsolete-packages
+Display obsolete packages (the packages that are installed in the
+current profile but cannot be found among available packages).
+
+@item M-x guix-search-by-name
+Display package(s) with the specified name.
+
+@item M-x guix-search-by-regexp
+Search for packages by a specified regexp. By default ``name'',
+``synopsis'' and ``description'' of the packages will be searched. This
+can be changed by modifying @code{guix-search-params} variable.
+
+@item M-x guix-generations
+List generations for the current profile. With numeric prefix, show so
+many last generations.
+
+@end table
+
+It is possible to change the currently used profile with
+@kbd{M-x@tie{}guix-set-current-profile}. This has the same effect as
+specifying @code{--profile} option for @command{guix package}
+(@pxref{Invoking guix package}).
+
+@node emacs General info
+@subsubsection General information
+
+The following keys are available for both ``list'' and ``info'' types of
+buffers:
+
+@table @kbd
+@item l
+@itemx r
+Go backward/forward by the history of the displayed results (this
+history is similar to the history of the Emacs @code{help-mode} or
+@code{Info-mode}).
+
+@item g
+Revert current buffer: update information about the displayed
+packages/generations and redisplay it.
+
+@item R
+Redisplay current buffer (without updating information).
+
+@item C-c C-z
+Go to the Guix REPL (@pxref{The REPL,,, geiser, Geiser User Manual}).
+
+@item h
+@itemx ?
+Describe current mode to see all available bindings.
+
+@end table
+
+@emph{Hint:} If you need several ``list'' or ``info'' buffers, you can
+simlpy @kbd{M-x clone-buffer} them, and each buffer will have its own
+history.
+
+@emph{Warning:} Name/version pairs cannot be used to identify packages
+(because a name is not necessarily unique), so ``guix.el'' uses special
+identifiers that live only during a guile session, so if the Guix REPL
+was restarted, you may want to revert ``list'' buffer (by pressing
+@kbd{g}).
+
+@node emacs List buffer
+@subsubsection ``List'' buffer
+
+An interface of a ``list'' buffer is similar to the interface provided
+by ``package.el'' (@pxref{Package Menu,,, emacs, The Emacs Editor}).
+
+Default key bindings available for both ``package-list'' and
+``generation-list'' buffers:
+
+@table @kbd
+@item m
+Mark the current entry.
+@item M
+Mark all entries.
+@item u
+Unmark the current entry.
+@item @key{DEL}
+Unmark backward.
+@item U
+Unmark all entries.
+@item S
+Sort entries by a specified column.
+@end table
+
+A ``package-list'' buffer additionally provides the following bindings:
+
+@table @kbd
+@item @key{RET}
+Describe marked packages (display available information in a
+``package-info'' buffer).
+@item i
+Mark a package for installation (with prefix, prompt for output(s) to
+install).
+@item d
+Mark a package for deletion.
+@item ^
+Mark a package for upgrading.
+@item x
+Execute actions on marked packages.
+@end table
+
+A ``generation-list'' buffer additionally provides the following
+bindings:
+
+@table @kbd
+@item @key{RET}
+List packages installed in the current generation.
+@item i
+Describe marked generations (display available information in a
+``generation-info'' buffer).
+@end table
+
+@node emacs Info buffer
+@subsubsection ``Info'' buffer
+
+The interface of an ``info'' buffer is similar to the interface of
+@code{help-mode} (@pxref{Help Mode,,, emacs, The Emacs Editor}).
+
+``Info'' buffer contains some buttons (as usual you may use @key{TAB} /
+@kbd{S-@key{TAB}} to move between buttons---@pxref{Mouse References,,,
+emacs, The Emacs Editor}) which can be used to:
+
+@itemize @bullet
+@item (in a ``package-info'' buffer)
+
+@itemize @minus
+@item install/remove a package;
+@item jump to a package location;
+@item browse home page of a package;
+@item describe packages from ``Inputs'' fields.
+@end itemize
+
+@item (in a ``generation-info'' buffer)
+
+@itemize @minus
+@item remove a generation;
+@item list packages installed in a generation;
+@item jump to a generation directory.
+@end itemize
+
+@end itemize
+
+
+@node emacs Configuration
+@subsection Configuration
+
+There are many variables you can modify to change the appearance or
+behavior of Emacs user interface. Some of these variables are described
+in this section. Also you can use Custom Interface (@pxref{Easy
+Customization,,, emacs, The Emacs Editor}) to explore/set variables (not
+all) and faces.
+
+@menu
+* Guile and Build Options: emacs Build Options. Specifying how packages are built.
+* Keymaps: emacs Keymaps. Configuring key bindings.
+* Appearance: emacs Appearance. Settings for visual appearance.
+@end menu
+
+@node emacs Build Options
+@subsubsection Guile and Build Options
+
+@table @code
+@item guix-guile-program
+If you have some special needs for starting a Guile process, you may set
+this variable, for example:
+
+@example
+(setq guix-guile-program '("/bin/guile" "--no-auto-compile"))
+@end example
+
+@item guix-use-substitutes
+Has the same meaning as @code{--no-substitutes} option (@pxref{Invoking
+guix build}).
+
+@item guix-dry-run
+Has the same meaning as @code{--dry-run} option (@pxref{Invoking guix
+build}).
+
+@end table
+
+@node emacs Keymaps
+@subsubsection Keymaps
+
+If you want to change default key bindings, use the following keymaps
+(@pxref{Init Rebinding,,, emacs, The Emacs Editor}):
+
+@table @code
+@item guix-list-mode-map
+Parent keymap with general keys for ``list'' buffers.
+
+@item guix-package-list-mode-map
+Keymap with specific keys for ``package-list'' buffers.
+
+@item guix-generation-list-mode-map
+Keymap with specific keys for ``generation-list'' buffers.
+
+@item guix-info-mode-map
+Parent keymap with general keys for ``info'' buffers.
+
+@item guix-package-info-mode-map
+Keymap with specific keys for ``package-info'' buffers.
+
+@item guix-generation-info-mode-map
+Keymap with specific keys for ``generation-info'' buffers.
+
+@end table
+
+@node emacs Appearance
+@subsubsection Appearance
+
+You can change almost any aspect of ``list'' / ``info'' buffers using
+the following variables:
+
+@table @code
+@item guix-list-column-format
+@itemx guix-list-column-titles
+@itemx guix-list-column-value-methods
+Specify the columns, their names, what and how is displayed in ``list''
+buffers.
+
+@item guix-info-displayed-params
+@itemx guix-info-insert-methods
+@itemx guix-info-ignore-empty-vals
+@itemx guix-info-param-title-format
+@itemx guix-info-multiline-prefix
+@itemx guix-info-indent
+@itemx guix-info-fill-column
+@itemx guix-info-delimiter
+Various settings for ``info'' buffers.
+
+@end table
@menu
* Features:: How Guix will make your life brighter.
* Invoking guix package:: Package installation, removal, etc.
+* Emacs Interface:: Package management from Emacs.
* Substitutes:: Downloading pre-built binaries.
* Packages with Multiple Outputs:: Single source package, multiple outputs.
* Invoking guix gc:: Running the garbage collector.
processes, it supports all the common build options that @command{guix
build} supports (@pxref{Invoking guix build, common build options}).
+@include emacs.texi
+
@node Substitutes
@section Substitutes
--- /dev/null
+# GNU Guix --- Functional package management for GNU
+# Copyright © 2014 Alex Kost <alezost@gmail.com>
+#
+# This file is part of GNU Guix.
+#
+# GNU Guix is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or (at
+# your option) any later version.
+#
+# GNU Guix is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+AUTOLOADS = emacs/guix-autoloads.el
+
+ELFILES = \
+ emacs/guix-backend.el \
+ emacs/guix-base.el \
+ emacs/guix-history.el \
+ emacs/guix-info.el \
+ emacs/guix-list.el \
+ emacs/guix-utils.el \
+ emacs/guix.el
+
+dist_lisp_DATA = \
+ $(ELFILES) \
+ $(AUTOLOADS)
+
+nodist_lisp_DATA = \
+ emacs/guix-init.el
+
+$(AUTOLOADS): $(ELFILES)
+ $(EMACS) --batch --eval \
+ "(let ((backup-inhibited t) \
+ (generated-autoload-file \
+ (expand-file-name \"$(AUTOLOADS)\" \"$(srcdir)\"))) \
+ (update-directory-autoloads \
+ (expand-file-name \"emacs\" \"$(srcdir)\")))"
--- /dev/null
+;;; guix-backend.el --- Communication with Geiser
+
+;; Copyright © 2014 Alex Kost <alezost@gmail.com>
+
+;; This file is part of GNU Guix.
+
+;; GNU Guix is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Guix is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file provides the code for interacting with Guile using Geiser.
+
+;; By default (if `guix-use-guile-server' is non-nil) 2 Geiser REPLs are
+;; started. The main one (with "guile --listen" process) is used for
+;; "interacting" with a user - for showing a progress of
+;; installing/deleting Guix packages. The second (internal) REPL is
+;; used for synchronous evaluating, e.g. when information about
+;; packages/generations should be received for a list/info buffer.
+;;
+;; This "2 REPLs concept" makes it possible to have a running process of
+;; installing/deleting packages and to continue to search/list/get info
+;; about other packages at the same time. If you prefer to use a single
+;; Guix REPL, do not try to receive any information while there is a
+;; running code in the REPL (see
+;; <https://github.com/jaor/geiser/issues/28>).
+;;
+;; If you need to use "guix.el" in another Emacs (i.e. when there is
+;; a runnig "guile --listen..." REPL somewhere), you can either change
+;; `guix-default-port' in that Emacs instance or set
+;; `guix-use-guile-server' to t.
+;;
+;; Guix REPLs (unlike the usual Geiser REPLs) are not added to
+;; `geiser-repl--repls' variable, and thus cannot be used for evaluating
+;; while editing scm-files. The only purpose of Guix REPLs is to be an
+;; intermediate between "Guix/Guile level" and "Emacs interface level".
+;; That being said you can still want to use a Guix REPL while hacking
+;; auxiliary scheme-files for "guix.el". You can just use "M-x
+;; connect-to-guile" (connect to "localhost" and `guix-default-port') to
+;; have a usual Geiser REPL with all stuff defined by "guix.el" package.
+
+;;; Code:
+
+(require 'geiser-mode)
+
+(defvar guix-load-path
+ (file-name-directory (or load-file-name
+ (locate-library "guix")))
+ "Directory with scheme files for \"guix.el\" package.")
+
+(defvar guix-helper-file
+ (expand-file-name "guix-helper.scm" guix-load-path)
+ "Auxiliary scheme file for loading.")
+
+(defvar guix-guile-program (or geiser-guile-binary "guile")
+ "Name of the guile executable used for Guix REPL.
+May be either a string (the name of the executable) or a list of
+strings of the form:
+
+ (NAME . ARGS)
+
+Where ARGS is a list of arguments to the guile program.")
+
+\f
+;;; REPL
+
+(defgroup guix-repl nil
+ "Settings for Guix REPLs."
+ :prefix "guix-repl-"
+ :group 'guix)
+
+(defcustom guix-repl-startup-time 30000
+ "Time, in milliseconds, to wait for Guix REPL to startup.
+Same as `geiser-repl-startup-time' but is used for Guix REPL.
+If you have a slow system, try to increase this time."
+ :type 'integer
+ :group 'guix-repl)
+
+(defcustom guix-repl-buffer-name "*Guix REPL*"
+ "Default name of a Geiser REPL buffer used for Guix."
+ :type 'string
+ :group 'guix-repl)
+
+(defcustom guix-after-start-repl-hook ()
+ "Hook called after Guix REPL is started."
+ :type 'hook
+ :group 'guix-repl)
+
+(defcustom guix-use-guile-server t
+ "If non-nil, start guile with '--listen' argument.
+This allows to receive information about packages using an additional
+REPL while some packages are being installed/removed in the main REPL."
+ :type 'boolean
+ :group 'guix-repl)
+
+(defcustom guix-default-port 37246
+ "Default port used if `guix-use-guile-server' is non-nil."
+ :type 'integer
+ :group 'guix-repl)
+
+(defvar guix-repl-buffer nil
+ "Main Geiser REPL buffer used for communicating with Guix.
+This REPL is used for processing package actions and for
+receiving information if `guix-use-guile-server' is nil.")
+
+(defvar guix-internal-repl-buffer nil
+ "Additional Geiser REPL buffer used for communicating with Guix.
+This REPL is used for receiving information only if
+`guix-use-guile-server' is non-nil.")
+
+(defvar guix-internal-repl-buffer-name "*Guix Internal REPL*"
+ "Default name of an internal Guix REPL buffer.")
+
+(defun guix-get-guile-program (&optional internal)
+ "Return a value suitable for `geiser-guile-binary'."
+ (if (or internal
+ (not guix-use-guile-server))
+ guix-guile-program
+ (append (if (listp guix-guile-program)
+ guix-guile-program
+ (list guix-guile-program))
+ ;; Guile understands "--listen=..." but not "--listen ..."
+ (list (concat "--listen="
+ (number-to-string guix-default-port))))))
+
+(defun guix-start-process-maybe ()
+ "Start Geiser REPL configured for Guix if needed."
+ (guix-start-repl-maybe)
+ (if guix-use-guile-server
+ (guix-start-repl-maybe 'internal)
+ (setq guix-internal-repl-buffer guix-repl-buffer)))
+
+(defun guix-start-repl-maybe (&optional internal)
+ "Start Guix REPL if needed.
+If INTERNAL is non-nil, start an internal REPL."
+ (let* ((repl-var (guix-get-repl-buffer-variable internal))
+ (repl (symbol-value repl-var)))
+ (unless (and (buffer-live-p repl)
+ (get-buffer-process repl))
+ ;; Kill REPL buffer with a dead process
+ (and (buffer-live-p repl) (kill-buffer repl))
+ (or internal
+ (message "Starting Geiser REPL for Guix ..."))
+ (let ((geiser-guile-binary (guix-get-guile-program internal))
+ (geiser-guile-init-file (or internal guix-helper-file))
+ (repl (get-buffer-create
+ (guix-get-repl-buffer-name internal))))
+ (condition-case err
+ (guix-start-repl repl
+ (and internal
+ (geiser-repl--read-address
+ "localhost" guix-default-port)))
+ (text-read-only
+ (error (concat "Couldn't start Guix REPL. Perhaps the port %s is busy.\n"
+ "See buffer '%s' for details")
+ guix-default-port (buffer-name repl))))
+ (set repl-var repl)
+ (unless internal
+ (message "Guix REPL has been started.")
+ (run-hooks 'guix-after-start-repl-hook))))))
+
+(defun guix-start-repl (buffer &optional address)
+ "Start Guix REPL in BUFFER.
+If ADDRESS is non-nil, connect to a remote guile process using
+this address (it should be defined by
+`geiser-repl--read-address')."
+ ;; A mix of the code from `geiser-repl--start-repl' and
+ ;; `geiser-repl--to-repl-buffer'.
+ (let ((impl 'guile)
+ (geiser-guile-load-path (list guix-load-path))
+ (geiser-repl-startup-time guix-repl-startup-time))
+ (with-current-buffer buffer
+ (geiser-repl-mode)
+ (geiser-impl--set-buffer-implementation impl)
+ (geiser-repl--autodoc-mode -1)
+ (goto-char (point-max))
+ (let* ((prompt-re (geiser-repl--prompt-regexp impl))
+ (deb-prompt-re (geiser-repl--debugger-prompt-regexp impl))
+ (prompt (geiser-con--combined-prompt prompt-re deb-prompt-re)))
+ (or prompt-re
+ (error "Oh no! Guix REPL in the buffer '%s' has not been started"
+ (buffer-name buffer)))
+ (geiser-repl--save-remote-data address)
+ (geiser-repl--start-scheme impl address prompt)
+ (geiser-repl--quit-setup)
+ (geiser-repl--history-setup)
+ (setq-local geiser-repl--repls (list buffer))
+ (geiser-repl--set-this-buffer-repl buffer)
+ (setq geiser-repl--connection
+ (geiser-con--make-connection
+ (get-buffer-process (current-buffer))
+ prompt-re
+ deb-prompt-re))
+ (geiser-repl--startup impl address)
+ (geiser-repl--autodoc-mode 1)
+ (geiser-company--setup geiser-repl-company-p)
+ (add-hook 'comint-output-filter-functions
+ 'geiser-repl--output-filter
+ nil t)
+ (set-process-query-on-exit-flag
+ (get-buffer-process (current-buffer))
+ geiser-repl-query-on-kill-p)))))
+
+(defun guix-get-repl-buffer (&optional internal)
+ "Return Guix REPL buffer; start REPL if needed.
+If INTERNAL is non-nil, return an additional internal REPL."
+ (guix-start-process-maybe)
+ (let ((repl (symbol-value (guix-get-repl-buffer-variable internal))))
+ ;; If a new Geiser REPL is started, `geiser-repl--repl' variable may
+ ;; be set to the new value in a Guix REPL, so set it back to a
+ ;; proper value here.
+ (with-current-buffer repl
+ (geiser-repl--set-this-buffer-repl repl))
+ repl))
+
+(defun guix-get-repl-buffer-variable (&optional internal)
+ "Return the name of a variable with a REPL buffer."
+ (if internal
+ 'guix-internal-repl-buffer
+ 'guix-repl-buffer))
+
+(defun guix-get-repl-buffer-name (&optional internal)
+ "Return the name of a REPL buffer."
+ (if internal
+ guix-internal-repl-buffer-name
+ guix-repl-buffer-name))
+
+(defun guix-switch-to-repl (&optional internal)
+ "Switch to Guix REPL.
+If INTERNAL is non-nil (interactively with prefix), switch to the
+additional internal REPL if it exists."
+ (interactive "P")
+ (geiser-repl--switch-to-buffer (guix-get-repl-buffer internal)))
+
+\f
+;;; Evaluating expressions
+
+(defun guix-make-guile-expression (fun &rest args)
+ "Return string containing a guile expression for calling FUN with ARGS."
+ (format "(%S %s)" fun
+ (mapconcat
+ (lambda (arg)
+ (cond
+ ((null arg) "'()")
+ ((or (eq arg t)
+ ;; An ugly hack to separate 'false' from nil
+ (equal arg 'f)
+ (keywordp arg))
+ (concat "#" (prin1-to-string arg t)))
+ ((or (symbolp arg) (listp arg))
+ (concat "'" (prin1-to-string arg)))
+ (t (prin1-to-string arg))))
+ args
+ " ")))
+
+(defun guix-eval (str &optional wrap)
+ "Evaluate guile expression STR.
+If WRAP is non-nil, wrap STR into (begin ...) form.
+Return a list of strings with result values of evaluation."
+ (with-current-buffer (guix-get-repl-buffer 'internal)
+ (let* ((wrapped (if wrap (geiser-debug--wrap-region str) str))
+ (code `(:eval (:scm ,wrapped)))
+ (ret (geiser-eval--send/wait code)))
+ (if (geiser-eval--retort-error ret)
+ (error "Error in evaluating guile expression: %s"
+ (geiser-eval--retort-output ret))
+ (cdr (assq 'result ret))))))
+
+(defun guix-eval-read (str &optional wrap)
+ "Evaluate guile expression STR.
+For the meaning of WRAP, see `guix-eval'.
+Return elisp expression of the first result value of evaluation."
+ ;; Parsing scheme code with elisp `read' is probably not the best idea.
+ (read (replace-regexp-in-string
+ "#f\\|#<unspecified>" "nil"
+ (replace-regexp-in-string
+ "#t" "t" (car (guix-eval str wrap))))))
+
+(defun guix-eval-in-repl (str)
+ "Switch to Guix REPL and evaluate STR with guile expression there."
+ (let ((repl (guix-get-repl-buffer)))
+ (with-current-buffer repl
+ (delete-region (geiser-repl--last-prompt-end) (point-max))
+ (goto-char (point-max))
+ (insert str)
+ (geiser-repl--send-input))
+ (geiser-repl--switch-to-buffer repl)))
+
+(provide 'guix-backend)
+
+;;; guix-backend.el ends here
--- /dev/null
+;;; guix-base.el --- Common definitions
+
+;; Copyright © 2014 Alex Kost <alezost@gmail.com>
+
+;; This file is part of GNU Guix.
+
+;; GNU Guix is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Guix is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file provides some base and common definitions for guix.el
+;; package.
+
+;; List and info buffers have many common patterns that are defined
+;; using `guix-define-buffer-type' macro from this file.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'guix-backend)
+(require 'guix-utils)
+
+\f
+;;; Profiles
+
+(defvar guix-user-profile
+ (expand-file-name "~/.guix-profile")
+ "User profile.")
+
+(defvar guix-default-profile
+ (concat (or (getenv "NIX_STATE_DIR") "/var/guix")
+ "/profiles/per-user/"
+ (getenv "USER")
+ "/guix-profile")
+ "Default Guix profile.")
+
+(defvar guix-current-profile guix-default-profile
+ "Current profile.")
+
+(defun guix-set-current-profile (path)
+ "Set `guix-current-profile' to PATH.
+Interactively, prompt for PATH. With prefix, use
+`guix-default-profile'."
+ (interactive
+ (list (if current-prefix-arg
+ guix-default-profile
+ (read-file-name "Set profile: "
+ (file-name-directory guix-current-profile)))))
+ (let ((path (directory-file-name (expand-file-name path))))
+ (setq guix-current-profile
+ (if (string= path guix-user-profile)
+ guix-default-profile
+ path))
+ (message "Current profile has been set to '%s'."
+ guix-current-profile)))
+
+\f
+;;; Parameters of the entries
+
+(defvar guix-param-titles
+ '((package
+ (id . "ID")
+ (name . "Name")
+ (version . "Version")
+ (license . "License")
+ (synopsis . "Synopsis")
+ (description . "Description")
+ (home-url . "Home page")
+ (outputs . "Outputs")
+ (inputs . "Inputs")
+ (native-inputs . "Native inputs")
+ (propagated-inputs . "Propagated inputs")
+ (location . "Location")
+ (installed . "Installed"))
+ (installed
+ (path . "Installed path")
+ (dependencies . "Dependencies")
+ (output . "Output"))
+ (generation
+ (id . "ID")
+ (number . "Number")
+ (prev-number . "Previous number")
+ (path . "Path")
+ (time . "Time")))
+ "List for defining titles of entry parameters.
+Titles are used for displaying information about entries.
+Each element of the list has a form:
+
+ (ENTRY-TYPE . ((PARAM . TITLE) ...))")
+
+(defun guix-get-param-title (entry-type param)
+ "Return title of an ENTRY-TYPE entry parameter PARAM."
+ (or (guix-get-key-val guix-param-titles
+ entry-type param)
+ (prog1 (symbol-name param)
+ (message "Couldn't find title for '%S %S'."
+ entry-type param))))
+
+(defun guix-get-name-spec (name version &optional output)
+ "Return Guix package specification by its NAME, VERSION and OUTPUT."
+ (concat name "-" version
+ (when output (concat ":" output))))
+
+(defun guix-get-full-name (entry &optional output)
+ "Return name specification of the package ENTRY and OUTPUT."
+ (guix-get-name-spec (guix-get-key-val entry 'name)
+ (guix-get-key-val entry 'version)
+ output))
+
+(defun guix-get-installed-outputs (entry)
+ "Return list of installed outputs for the package ENTRY."
+ (mapcar (lambda (installed-entry)
+ (guix-get-key-val installed-entry 'output))
+ (guix-get-key-val entry 'installed)))
+
+(defun guix-get-entry-by-id (id entries)
+ "Return entry from ENTRIES by entry ID."
+ (cl-find-if (lambda (entry)
+ (equal id (guix-get-key-val entry 'id)))
+ entries))
+
+\f
+;;; Location of the packages
+
+(defvar guix-directory nil
+ "Default Guix directory.
+If it is not set by a user, it is set after starting Guile REPL.
+This directory is used to define location of the packages.")
+
+(defun guix-set-directory ()
+ "Set `guix-directory' if needed."
+ (or guix-directory
+ (setq guix-directory
+ (guix-eval-read "%guix-dir"))))
+
+(add-hook 'guix-after-start-repl-hook 'guix-set-directory)
+
+(defun guix-find-location (location)
+ "Go to LOCATION of a package.
+LOCATION is a string of the form:
+
+ \"PATH:LINE:COLUMN\"
+
+If PATH is relative, it is considered to be relative to
+`guix-directory'."
+ (cl-multiple-value-bind (path line col)
+ (split-string location ":")
+ (let ((file (expand-file-name path guix-directory))
+ (line (string-to-number line))
+ (col (string-to-number col)))
+ (find-file file)
+ (goto-char (point-min))
+ (forward-line (- line 1))
+ (move-to-column col)
+ (recenter 1))))
+
+\f
+;;; Common definitions for buffer types
+
+(defvar-local guix-entries nil
+ "List of the currently displayed entries.
+Each element of the list is alist with entry info of the
+following form:
+
+ ((PARAM . VAL) ...)
+
+PARAM is a name of the entry parameter.
+VAL is a value of this parameter.")
+(put 'guix-entries 'permanent-local t)
+
+(defvar-local guix-search-type nil
+ "Type of the current search.")
+(put 'guix-search-type 'permanent-local t)
+
+(defvar-local guix-search-vals nil
+ "Values of the current search.")
+(put 'guix-search-vals 'permanent-local t)
+
+(defsubst guix-set-vars (entries search-type search-vals)
+ (setq guix-entries entries
+ guix-search-type search-type
+ guix-search-vals search-vals))
+
+(defmacro guix-define-buffer-type (buf-type entry-type &rest args)
+ "Define common stuff for BUF-TYPE buffers for displaying entries.
+
+ENTRY-TYPE is a type of displayed entries (see
+`guix-get-entries').
+
+In the text below TYPE means ENTRY-TYPE-BUF-TYPE.
+
+This macro defines `guix-TYPE-mode', a custom group, several user
+variables and the following functions:
+
+ - `guix-TYPE-get-params-for-receiving'
+ - `guix-TYPE-revert'
+ - `guix-TYPE-redisplay'
+ - `guix-TYPE-make-history-item'
+ - `guix-TYPE-set'
+ - `guix-TYPE-show'
+ - `guix-TYPE-get-show'
+
+The following stuff should be defined outside this macro:
+
+ - `guix-BUF-TYPE-mode' - parent mode for the defined mode.
+
+ - `guix-BUF-TYPE-insert-entries' - function for inserting
+ entries in the current buffer; it is called with 2 arguments:
+ entries of the form of `guix-entries' and ENTRY-TYPE.
+
+ - `guix-BUF-TYPE-get-displayed-params' - function returning a
+ list of parameters displayed in the current buffer; it is
+ called with ENTRY-TYPE as argument.
+
+ - `guix-TYPE-mode-initialize' (optional) - function for
+ additional mode settings; it is called without arguments.
+
+Remaining argument (ARGS) should have a form [KEYWORD VALUE] ... The
+following keywords are available:
+
+ - `:required' - default value for the defined
+ `guix-TYPE-required-params' variable.
+
+ - `:history-size' - default value for the defined
+ `guix-TYPE-history-size' variable.
+
+ - `:revert' - default value for the defined
+ `guix-TYPE-revert-no-confirm' variable."
+ (let* ((entry-type-str (symbol-name entry-type))
+ (buf-type-str (symbol-name buf-type))
+ (Entry-type-str (capitalize entry-type-str))
+ (Buf-type-str (capitalize buf-type-str))
+ (entry-str (concat entry-type-str " entries"))
+ (buf-str (concat buf-type-str " buffer"))
+ (prefix (concat "guix-" entry-type-str "-" buf-type-str))
+ (group (intern prefix))
+ (mode-map-str (concat prefix "-mode-map"))
+ (mode-map (intern mode-map-str))
+ (parent-mode (intern (concat "guix-" buf-type-str "-mode")))
+ (mode (intern (concat prefix "-mode")))
+ (mode-init-fun (intern (concat prefix "-mode-initialize")))
+ (buf-name-var (intern (concat prefix "-buffer-name")))
+ (revert-var (intern (concat prefix "-revert-no-confirm")))
+ (revert-fun (intern (concat prefix "-revert")))
+ (redisplay-fun (intern (concat prefix "-redisplay")))
+ (history-var (intern (concat prefix "-history-size")))
+ (history-fun (intern (concat prefix "-make-history-item")))
+ (params-var (intern (concat prefix "-required-params")))
+ (params-fun (intern (concat prefix "-get-params-for-receiving")))
+ (set-fun (intern (concat prefix "-set")))
+ (show-fun (intern (concat prefix "-show")))
+ (get-show-fun (intern (concat prefix "-get-show")))
+ (revert-val nil)
+ (history-val 20)
+ (params-val '(id)))
+
+ ;; Process the keyword args.
+ (while (keywordp (car args))
+ (pcase (pop args)
+ (`:required (setq params-val (pop args)))
+ (`:history-size (setq history-val (pop args)))
+ (`:revert (setq revert-val (pop args)))
+ (_ (pop args))))
+
+ `(progn
+ (defgroup ,group nil
+ ,(concat Buf-type-str " buffer with " entry-str ".")
+ :prefix ,(concat prefix "-")
+ :group ',(intern (concat "guix-" buf-type-str)))
+
+ (defcustom ,buf-name-var ,(format "*Guix %s %s*"
+ Entry-type-str Buf-type-str)
+ ,(concat "Default name of the " buf-str " for displaying " entry-str ".")
+ :type 'string
+ :group ',group)
+
+ (defcustom ,history-var ,history-val
+ ,(concat "Maximum number of items saved in the history of the " buf-str ".\n"
+ "If 0, the history is disabled.")
+ :type 'integer
+ :group ',group)
+
+ (defcustom ,revert-var ,revert-val
+ ,(concat "If non-nil, do not ask to confirm for reverting the " buf-str ".")
+ :type 'boolean
+ :group ',group)
+
+ (defvar ,params-var ',params-val
+ ,(concat "List of required " entry-type-str " parameters.\n\n"
+ "Displayed parameters and parameters from this list are received\n"
+ "for each " entry-type-str ".\n\n"
+ "May be a special value `all', in which case all supported\n"
+ "parameters are received (this may be very slow for a big number\n"
+ "of entries).\n\n"
+ "Do not remove `id' from this list as it is required for\n"
+ "identifying an entry."))
+
+ (define-derived-mode ,mode ,parent-mode ,(concat "Guix-" Buf-type-str)
+ ,(concat "Major mode for displaying information about " entry-str ".\n\n"
+ "\\{" mode-map-str "}")
+ (setq-local revert-buffer-function ',revert-fun)
+ (setq-local guix-history-size ,history-var)
+ (and (fboundp ',mode-init-fun) (,mode-init-fun)))
+
+ (let ((map ,mode-map))
+ (define-key map (kbd "l") 'guix-history-back)
+ (define-key map (kbd "r") 'guix-history-forward)
+ (define-key map (kbd "g") 'revert-buffer)
+ (define-key map (kbd "R") ',redisplay-fun)
+ (define-key map (kbd "C-c C-z") 'guix-switch-to-repl))
+
+ (defun ,params-fun ()
+ ,(concat "Return " entry-type-str " parameters that should be received.")
+ (unless (equal ,params-var 'all)
+ (cl-union ,params-var
+ (,(intern (concat "guix-" buf-type-str "-get-displayed-params"))
+ ',entry-type))))
+
+ (defun ,revert-fun (_ignore-auto noconfirm)
+ "Update information in the current buffer.
+The function is suitable for `revert-buffer-function'.
+See `revert-buffer' for the meaning of NOCONFIRM."
+ (when (or ,revert-var
+ noconfirm
+ (y-or-n-p "Update current information? "))
+ (let ((entries (guix-get-entries ',entry-type guix-search-type
+ guix-search-vals (,params-fun))))
+ (,set-fun entries guix-search-type guix-search-vals t))))
+
+ (defun ,redisplay-fun ()
+ "Redisplay current information.
+This function will not update the information, use
+\"\\[revert-buffer]\" if you want the full update."
+ (interactive)
+ (,show-fun guix-entries)
+ (guix-result-message guix-entries ',entry-type
+ guix-search-type guix-search-vals))
+
+ (defun ,history-fun ()
+ "Make and return a history item for the current buffer."
+ (list (lambda (entries search-type search-vals)
+ (,show-fun entries)
+ (guix-set-vars entries search-type search-vals)
+ (guix-result-message entries ',entry-type
+ search-type search-vals))
+ guix-entries guix-search-type guix-search-vals))
+
+ (defun ,set-fun (entries search-type search-vals &optional history-replace)
+ ,(concat "Set up the " buf-str " for displaying " entry-str ".\n\n"
+ "Display ENTRIES, set variables and make history item.\n\n"
+ "ENTRIES should have a form of `guix-entries'.\n\n"
+ "See `guix-get-entries' for the meaning of SEARCH-TYPE and\n"
+ "SEARCH-VALS.\n\n"
+ "If HISTORY-REPLACE is non-nil, replace current history item,\n"
+ "otherwise add the new one.")
+ (when entries
+ (let ((buf (if (eq major-mode ',mode)
+ (current-buffer)
+ (get-buffer-create ,buf-name-var))))
+ (with-current-buffer buf
+ (,show-fun entries)
+ (guix-set-vars entries search-type search-vals)
+ (funcall (if history-replace
+ #'guix-history-replace
+ #'guix-history-add)
+ (,history-fun)))
+ (pop-to-buffer buf
+ '((display-buffer-reuse-window
+ display-buffer-same-window)))))
+ (guix-result-message entries ',entry-type
+ search-type search-vals))
+
+ (defun ,show-fun (entries)
+ ,(concat "Display " entry-type-str " ENTRIES in the current " buf-str ".")
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (,mode)
+ (,(intern (concat "guix-" buf-type-str "-insert-entries"))
+ entries ',entry-type)
+ (goto-char (point-min))))
+
+ (defun ,get-show-fun (search-type &rest search-vals)
+ ,(concat "Search for " entry-str " and show results in the " buf-str ".\n"
+ "See `guix-get-entries' for the meaning of SEARCH-TYPE and\n"
+ "SEARCH-VALS.")
+ (let ((entries (guix-get-entries ',entry-type search-type
+ search-vals (,params-fun))))
+ (,set-fun entries search-type search-vals))))))
+
+(put 'guix-define-buffer-type 'lisp-indent-function 'defun)
+
+\f
+;;; Messages
+
+(defvar guix-messages
+ '((package
+ (id
+ (0 "Packages not found.")
+ (1 "")
+ (many "%d packages." count))
+ (name
+ (0 "The package '%s' not found." val)
+ (1 "A single package with name '%s'." val)
+ (many "%d packages with '%s' name." count val))
+ (regexp
+ (0 "No packages matching '%s'." val)
+ (1 "A single package matching '%s'." val)
+ (many "%d packages matching '%s'." count val))
+ (all-available
+ (0 "No packages are available for some reason.")
+ (1 "A single available package (that's strange).")
+ (many "%d available packages." count))
+ (newest-available
+ (0 "No packages are available for some reason.")
+ (1 "A single newest available package (that's strange).")
+ (many "%d newest available packages." count))
+ (installed
+ (0 "No installed packages.")
+ (1 "A single installed package.")
+ (many "%d installed packages." count))
+ (obsolete
+ (0 "No obsolete packages.")
+ (1 "A single obsolete package.")
+ (many "%d obsolete packages." count))
+ (generation
+ (0 "No packages installed in generation %d." val)
+ (1 "A single package installed in generation %d." val)
+ (many "%d packages installed in generation %d." count val)))
+ (generation
+ (id
+ (0 "Generations not found.")
+ (1 "")
+ (many "%d generations." count))
+ (last
+ (0 "No available generations.")
+ (1 "The last generation.")
+ (many "%d last generations." count))
+ (all
+ (0 "No available generations.")
+ (1 "A single available generation.")
+ (many "%d available generations." count)))))
+
+(defun guix-result-message (entries entry-type search-type search-vals)
+ "Display an appropriate message after displaying ENTRIES."
+ (let* ((val (car search-vals))
+ (count (length entries))
+ (count-key (if (> count 1) 'many count))
+ (msg-spec (guix-get-key-val guix-messages
+ entry-type search-type count-key))
+ (format (car msg-spec))
+ (args (cdr msg-spec)))
+ (mapc (lambda (subst)
+ (setq args (cl-substitute (car subst) (cdr subst) args)))
+ (list (cons count 'count)
+ (cons val 'val)))
+ (apply #'message format args)))
+
+\f
+;;; Getting info about packages and generations
+
+(defun guix-get-entries (entry-type search-type search-vals &optional params)
+ "Search for entries of ENTRY-TYPE.
+
+Call an appropriate scheme function and return a list of the
+form of `guix-entries'.
+
+ENTRY-TYPE should be one of the following symbols: `package' or
+`generation'.
+
+SEARCH-TYPE may be one of the following symbols:
+
+- If ENTRY-TYPE is `package': `id', `name', `regexp',
+ `all-available', `newest-available', `installed', `obsolete',
+ `generation'.
+
+- If ENTRY-TYPE is `generation': `id', `last', `all'.
+
+PARAMS is a list of parameters for receiving. If nil, get
+information with all available parameters."
+ (guix-eval-read (guix-make-guile-expression
+ 'get-entries
+ guix-current-profile params
+ entry-type search-type search-vals)))
+
+\f
+;;; Actions on packages and generations
+
+(defcustom guix-operation-confirm t
+ "If nil, do not prompt to confirm an operation."
+ :type 'boolean
+ :group 'guix)
+
+(defcustom guix-use-substitutes t
+ "If non-nil, use substitutes for the Guix packages."
+ :type 'boolean
+ :group 'guix)
+
+(defvar guix-dry-run nil
+ "If non-nil, do not perform the real actions, just simulate.")
+
+(defvar guix-temp-buffer-name " *Guix temp*"
+ "Name of a buffer used for displaying info before executing operation.")
+
+(defun guix-process-package-actions (&rest actions)
+ "Process package ACTIONS.
+Each action is a list of the form:
+
+ (ACTION-TYPE PACKAGE-SPEC ...)
+
+ACTION-TYPE is one of the following symbols: `install',
+`upgrade', `remove'/`delete'.
+PACKAGE-SPEC should have the following form: (ID [OUTPUT] ...)."
+ (let (install upgrade remove)
+ (mapc (lambda (action)
+ (let ((action-type (car action))
+ (specs (cdr action)))
+ (cl-case action-type
+ (install (setq install (append install specs)))
+ (upgrade (setq upgrade (append upgrade specs)))
+ ((remove delete) (setq remove (append remove specs))))))
+ actions)
+ (when (guix-continue-package-operation-p
+ :install install :upgrade upgrade :remove remove)
+ (guix-eval-in-repl
+ (guix-make-guile-expression
+ 'process-package-actions guix-current-profile
+ :install install :upgrade upgrade :remove remove
+ :use-substitutes? (or guix-use-substitutes 'f)
+ :dry-run? (or guix-dry-run 'f))))))
+
+(cl-defun guix-continue-package-operation-p (&key install upgrade remove)
+ "Return non-nil if a package operation should be continued.
+Ask a user if needed (see `guix-operation-confirm').
+INSTALL, UPGRADE, REMOVE are 'package action specifications'.
+See `guix-process-package-actions' for details."
+ (or (null guix-operation-confirm)
+ (let* ((entries (guix-get-entries
+ 'package 'id
+ (list (append (mapcar #'car install)
+ (mapcar #'car upgrade)
+ (mapcar #'car remove)))
+ '(id name version location)))
+ (install-strings (guix-get-package-strings install entries))
+ (upgrade-strings (guix-get-package-strings upgrade entries))
+ (remove-strings (guix-get-package-strings remove entries)))
+ (if (or install-strings upgrade-strings remove-strings)
+ (let ((buf (get-buffer-create guix-temp-buffer-name)))
+ (with-current-buffer buf
+ (setq-local cursor-type nil)
+ (setq buffer-read-only nil)
+ (erase-buffer)
+ (guix-insert-package-strings install-strings "install")
+ (guix-insert-package-strings upgrade-strings "upgrade")
+ (guix-insert-package-strings remove-strings "remove")
+ (let ((win (temp-buffer-window-show
+ buf
+ '((display-buffer-reuse-window
+ display-buffer-at-bottom)
+ (window-height . fit-window-to-buffer)))))
+ (prog1 (y-or-n-p "Continue operation? ")
+ (quit-window nil win)))))
+ (message "Nothing to be done. If the REPL was restarted, information is not up-to-date.")
+ nil))))
+
+(defun guix-get-package-strings (specs entries)
+ "Return short package descriptions for performing package actions.
+See `guix-process-package-actions' for the meaning of SPECS.
+ENTRIES is a list of package entries to get info about packages."
+ (delq nil
+ (mapcar
+ (lambda (spec)
+ (let* ((id (car spec))
+ (outputs (cdr spec))
+ (entry (guix-get-entry-by-id id entries)))
+ (when entry
+ (let ((location (guix-get-key-val entry 'location)))
+ (concat (guix-get-full-name entry)
+ (when outputs
+ (concat ":"
+ (mapconcat #'identity outputs ",")))
+ (when location
+ (concat "\t(" location ")")))))))
+ specs)))
+
+(defun guix-insert-package-strings (strings action)
+ "Insert information STRINGS at point for performing package ACTION."
+ (when strings
+ (insert "Package(s) to " (guix-get-string action 'bold) ":\n")
+ (mapc (lambda (str)
+ (insert " " str "\n"))
+ strings)
+ (insert "\n")))
+
+(provide 'guix-base)
+
+;;; guix-base.el ends here
--- /dev/null
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This is an auxiliary file for the Emacs UI. It is used to add Guix
+;; directories to path variables and to load the main code.
+
+;;; Code:
+
+(use-modules (ice-9 regex)
+ (srfi srfi-26))
+
+(define %guix-dir)
+
+;; The code is taken from ‘guix’ executable script
+(define (set-paths!)
+ (define-syntax-rule (push! elt v) (set! v (cons elt v)))
+
+ (define config-lookup
+ (let ((config '(("prefix" . "@prefix@")
+ ("guilemoduledir" . "@guilemoduledir@")))
+ (var-ref-regexp (make-regexp "\\$\\{([a-z]+)\\}")))
+ (define (expand-var-ref match)
+ (lookup (match:substring match 1)))
+ (define (expand str)
+ (regexp-substitute/global #f var-ref-regexp str
+ 'pre expand-var-ref 'post))
+ (define (lookup name)
+ (expand (assoc-ref config name)))
+ lookup))
+
+ (let ((module-dir (config-lookup "guilemoduledir"))
+ (updates-dir (and=> (or (getenv "XDG_CONFIG_HOME")
+ (and=> (getenv "HOME")
+ (cut string-append <> "/.config")))
+ (cut string-append <> "/guix/latest"))))
+ (push! module-dir %load-compiled-path)
+ (if (and updates-dir (file-exists? updates-dir))
+ (begin
+ (set! %guix-dir updates-dir)
+ (push! updates-dir %load-path)
+ (push! updates-dir %load-compiled-path))
+ (set! %guix-dir module-dir))))
+
+(set-paths!)
+
+(load-from-path "guix-main")
+
--- /dev/null
+;;; guix-history.el --- History of buffer information
+
+;; Copyright © 2014 Alex Kost <alezost@gmail.com>
+
+;; This file is part of GNU Guix.
+
+;; GNU Guix is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Guix is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file provides support for history of buffers similar to the
+;; history of a `help-mode' buffer.
+
+;;; Code:
+
+(require 'cl-macs)
+
+(defvar-local guix-history-stack-item nil
+ "Current item of the history.
+A list of the form (FUNCTION [ARGS ...]).
+The item is used by calling (apply FUNCTION ARGS).")
+(put 'guix-history-stack-item 'permanent-local t)
+
+(defvar-local guix-history-back-stack nil
+ "Stack (list) of visited items.
+Each element of the list has a form of `guix-history-stack-item'.")
+(put 'guix-history-back-stack 'permanent-local t)
+
+(defvar-local guix-history-forward-stack nil
+ "Stack (list) of items visited with `guix-history-back'.
+Each element of the list has a form of `guix-history-stack-item'.")
+(put 'guix-history-forward-stack 'permanent-local t)
+
+(defvar guix-history-size 0
+ "Maximum number of items saved in history.
+If 0, the history is disabled.")
+
+(defun guix-history-add (item)
+ "Add ITEM to history."
+ (and guix-history-stack-item
+ (push guix-history-stack-item guix-history-back-stack))
+ (setq guix-history-forward-stack nil
+ guix-history-stack-item item)
+ (when (>= (length guix-history-back-stack)
+ guix-history-size)
+ (setq guix-history-back-stack
+ (cl-loop for elt in guix-history-back-stack
+ for i from 1 to guix-history-size
+ collect elt))))
+
+(defun guix-history-replace (item)
+ "Replace current item in history with ITEM."
+ (setq guix-history-stack-item item))
+
+(defun guix-history-goto (item)
+ "Go to the ITEM of history.
+ITEM should have the form of `guix-history-stack-item'."
+ (or (listp item)
+ (error "Wrong value of history element"))
+ (setq guix-history-stack-item item)
+ (apply (car item) (cdr item)))
+
+(defun guix-history-back ()
+ "Go back to the previous element of history in the current buffer."
+ (interactive)
+ (or guix-history-back-stack
+ (user-error "No previous element in history"))
+ (push guix-history-stack-item guix-history-forward-stack)
+ (guix-history-goto (pop guix-history-back-stack)))
+
+(defun guix-history-forward ()
+ "Go forward to the next element of history in the current buffer."
+ (interactive)
+ (or guix-history-forward-stack
+ (user-error "No next element in history"))
+ (push guix-history-stack-item guix-history-back-stack)
+ (guix-history-goto (pop guix-history-forward-stack)))
+
+(provide 'guix-history)
+
+;;; guix-history.el ends here
--- /dev/null
+;;; guix-info.el --- Info buffers for displaying entries
+
+;; Copyright © 2014 Alex Kost <alezost@gmail.com>
+
+;; This file is part of GNU Guix.
+
+;; GNU Guix is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Guix is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file provides a help-like buffer for displaying information
+;; about Guix packages and generations.
+
+;;; Code:
+
+(require 'guix-history)
+(require 'guix-base)
+(require 'guix-utils)
+
+(defgroup guix-info nil
+ "General settings for info buffers."
+ :prefix "guix-info-"
+ :group 'guix)
+
+(defface guix-info-param-title
+ '((t :inherit font-lock-type-face))
+ "Face used for titles of parameters."
+ :group 'guix-info)
+
+(defface guix-info-file-path
+ '((t :inherit link))
+ "Face used for file paths."
+ :group 'guix-info)
+
+(defface guix-info-url
+ '((t :inherit link))
+ "Face used for URLs."
+ :group 'guix-info)
+
+(defface guix-info-time
+ '((t :inherit font-lock-constant-face))
+ "Face used for timestamps."
+ :group 'guix-info)
+
+(defface guix-info-action-button
+ '((((type x w32 ns) (class color))
+ :box (:line-width 2 :style released-button)
+ :background "lightgrey" :foreground "black")
+ (t :inherit button))
+ "Face used for action buttons."
+ :group 'guix-info)
+
+(defface guix-info-action-button-mouse
+ '((((type x w32 ns) (class color))
+ :box (:line-width 2 :style released-button)
+ :background "grey90" :foreground "black")
+ (t :inherit highlight))
+ "Mouse face used for action buttons."
+ :group 'guix-info)
+
+(defcustom guix-info-ignore-empty-vals nil
+ "If non-nil, do not display parameters with nil values."
+ :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'.")
+
+(defvar guix-info-multiline-prefix (make-string 20 ?\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'.")
+
+(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)
+ (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))
+ (generation
+ (number guix-generation-info-insert-number)
+ (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 location home-url
+ license inputs native-inputs propagated-inputs description)
+ (installed path dependencies)
+ (generation number prev-number 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-get-key-val 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-get-key-val guix-info-displayed-params
+ entry-type))
+
+(defun guix-info-get-indent (&optional level)
+ "Return `guix-info-indent' \"multiplied\" by LEVEL spaces.
+LEVEL is 1 by default."
+ (make-string (* guix-info-indent (or level 1)) ?\s))
+
+(defun guix-info-insert-indent (&optional level)
+ "Insert `guix-info-indent' spaces LEVEL times (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'."
+ (guix-mapinsert (lambda (entry)
+ (guix-info-insert-entry entry entry-type))
+ entries
+ guix-info-delimiter))
+
+(defun guix-info-insert-entry (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-param (param 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-get-key-val 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."
+ (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)
+ "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-action-button (label action &optional message
+ &rest properties)
+ "Make action button with LABEL and insert it at point.
+For the meaning of ACTION, MESSAGE and PROPERTIES, see
+`guix-insert-button'."
+ (apply #'guix-insert-button
+ label 'guix-info-action-button action message
+ 'mouse-face 'guix-info-action-button-mouse
+ properties))
+
+(defun guix-info-insert-file-path (path &optional _)
+ "Make button from file PATH and insert it at point."
+ (guix-insert-button
+ path 'guix-info-file-path
+ (lambda (btn) (find-file (button-label btn)))
+ "Find file"))
+
+(defun guix-info-insert-url (url &optional _)
+ "Make button from URL and insert it at point."
+ (guix-insert-button
+ url 'guix-info-url
+ (lambda (btn) (browse-url (button-label btn)))
+ "Browse URL"))
+
+(defun guix-info-insert-time (seconds &optional _)
+ "Insert formatted time string using SECONDS at point."
+ (guix-info-insert-val-default (guix-get-time-string seconds)
+ 'guix-info-time))
+
+\f
+(defvar guix-info-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent
+ map (make-composed-keymap button-buffer-map
+ special-mode-map))
+ map)
+ "Parent keymap for info buffers.")
+
+(define-derived-mode guix-info-mode special-mode "Guix-Info"
+ "Parent mode for displaying information in info buffers.")
+
+\f
+;;; Displaying packages
+
+(guix-define-buffer-type info package
+ :required (id installed non-unique))
+
+(defface guix-package-info-name
+ '((t :inherit font-lock-keyword-face))
+ "Face used for a name of a package."
+ :group 'guix-package-info)
+
+(defface guix-package-info-version
+ '((t :inherit font-lock-builtin-face))
+ "Face used for a version of a package."
+ :group 'guix-package-info)
+
+(defface guix-package-info-synopsis
+ '((t :inherit font-lock-doc-face))
+ "Face used for a synopsis of a package."
+ :group 'guix-package-info)
+
+(defface guix-package-info-description
+ '((t))
+ "Face used for a description of a package."
+ :group 'guix-package-info)
+
+(defface guix-package-info-license
+ '((t :inherit font-lock-string-face))
+ "Face used for a license of a package."
+ :group 'guix-package-info)
+
+(defface guix-package-info-location
+ '((t :inherit link))
+ "Face used for a location of a package."
+ :group 'guix-package-info)
+
+(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)
+
+(defface guix-package-info-uninstalled-outputs
+ '((t :weight bold))
+ "Face used for uninstalled outputs of a package."
+ :group 'guix-package-info)
+
+(defface guix-package-info-obsolete
+ '((t :inherit error))
+ "Face used if a package is obsolete."
+ :group 'guix-package-info)
+
+(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-info-location
+ (lambda (btn) (guix-find-location (button-label btn)))
+ "Find location of this package"))
+
+(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")))
+ (fun (intern (concat "guix-package-info-insert-" type-name "inputs"))))
+ `(progn
+ (defface ,face
+ '((t :inherit button))
+ ,(concat "Face used for " type-desc "inputs of a package.")
+ :group 'guix-package-info)
+
+ (defun ,fun (inputs &optional _)
+ ,(concat "Make buttons from " type-desc "INPUTS and insert them at point.")
+ (guix-package-info-insert-full-names inputs ',face)))))
+
+(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 face)
+ "Make buttons from package NAMES and insert them at point.
+NAMES is a list of strings.
+Propertize buttons with FACE."
+ (if names
+ (guix-info-insert-val-default
+ (with-temp-buffer
+ (guix-mapinsert (lambda (name)
+ (guix-package-info-insert-full-name
+ name face))
+ names
+ guix-list-separator)
+ (buffer-substring (point-min) (point-max))))
+ (guix-format-insert nil)))
+
+(defun guix-package-info-insert-full-name (name face)
+ "Make button and insert package NAME at point.
+Propertize package button with FACE."
+ (guix-insert-button
+ name face
+ (lambda (btn)
+ (guix-package-info-get-show 'name (button-label btn)))
+ "Describe this package"))
+
+\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-get-key-val entry 'obsolete)
+ (guix-package-info-insert-obsolete-text))
+ (and (guix-get-key-val entry 'non-unique)
+ (guix-get-key-val 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-package-info-insert-full-name full-name
+ 'guix-package-info-inputs)
+ (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-get-key-val entry 'installed))
+ (obsolete (guix-get-key-val entry 'obsolete))
+ (installed-entry (cl-find-if
+ (lambda (entry)
+ (string= (guix-get-key-val 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
+ (list (button-get btn 'action-type)
+ (list (button-get btn 'id)
+ (button-get btn 'output)))))
+ (concat type-str " '" full-name "'")
+ 'action-type type
+ 'id (guix-get-key-val 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))
+
+(defun guix-package-info-insert-output-dependencies (deps &optional _)
+ "Insert dependencies DEPS of the installed output."
+ (guix-info-insert-val-simple deps #'guix-info-insert-file-path))
+
+\f
+;;; 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)
+
+(declare-function guix-package-list-get-show "guix-list" t t)
+
+(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-package-list-get-show '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) (error "Sorry, not implemented yet"))
+ "Delete this generation"))
+
+(provide 'guix-info)
+
+;;; guix-info.el ends here
--- /dev/null
+(require 'guix-autoloads)
+
+(defvar guix-load-path
+ (replace-regexp-in-string "${prefix}" "@prefix@" "@emacsuidir@")
+ "Directory with scheme files for \"guix.el\" package.")
+
+(defvar guix-default-profile
+ (concat (or (getenv "NIX_STATE_DIR") "@guix_localstatedir@/guix")
+ "/profiles/per-user/"
+ (getenv "USER")
+ "/guix-profile")
+ "Default Guix profile.")
+
+(provide 'guix-init)
--- /dev/null
+;;; guix-list.el --- List buffers for displaying entries -*- lexical-binding: t -*-
+
+;; Copyright © 2014 Alex Kost <alezost@gmail.com>
+
+;; This file is part of GNU Guix.
+
+;; GNU Guix is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Guix is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file provides a list-like buffer for displaying information
+;; about Guix packages and generations.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'tabulated-list)
+(require 'guix-info)
+(require 'guix-history)
+(require 'guix-base)
+(require 'guix-utils)
+
+(defgroup guix-list nil
+ "General settings for list buffers."
+ :prefix "guix-list-"
+ :group 'guix)
+
+(defface guix-list-file-path
+ '((t :inherit guix-info-file-path))
+ "Face used for file paths."
+ :group 'guix-list)
+
+(defcustom guix-list-describe-warning-count 10
+ "The maximum number of entries for describing without a warning.
+If a user wants to describe more than this number of marked
+entries, he will be prompted for confirmation."
+ :type 'integer
+ :group 'guix-list)
+
+(defvar guix-list-column-format
+ `((package
+ (name 20 t)
+ (version 10 nil)
+ (outputs 13 t)
+ (installed 13 t)
+ (synopsis 30 nil))
+ (generation
+ (number 5
+ ,(lambda (a b) (guix-list-sort-numerically 0 a b))
+ :right-align t)
+ (time 20 t)
+ (path 30 t)))
+ "Columns displayed in list buffers.
+Each element of the list has a form:
+
+ (ENTRY-TYPE . ((PARAM WIDTH SORT . PROPS) ...))
+
+PARAM is the name of an entry parameter of ENTRY-TYPE. For the
+meaning of WIDTH, SORT and PROPS, see `tabulated-list-format'.")
+
+(defvar guix-list-column-titles
+ '((generation
+ (number . "N.")))
+ "Column titles for list buffers.
+Has the same structure as `guix-param-titles', but titles from
+this list have a priority.")
+
+(defvar guix-list-column-value-methods
+ '((package
+ (name . guix-package-list-get-name)
+ (synopsis . guix-list-get-one-line)
+ (description . guix-list-get-one-line)
+ (installed . guix-package-list-get-installed-outputs))
+ (generation
+ (time . guix-list-get-time)
+ (path . guix-list-get-file-path)))
+ "Methods for inserting parameter values in columns.
+Each element of the list has a form:
+
+ (ENTRY-TYPE . ((PARAM . FUN) ...))
+
+PARAM is the name of an entry parameter of ENTRY-TYPE.
+
+FUN is a function returning a value that will be inserted. The
+function is called with 2 arguments: the first one is the value
+of the parameter; the second argument is an entry info (alist of
+parameters and their values).")
+
+(defun guix-list-get-param-title (entry-type param)
+ "Return title of an ENTRY-TYPE entry parameter PARAM."
+ (or (guix-get-key-val guix-list-column-titles
+ entry-type param)
+ (guix-get-param-title entry-type param)))
+
+(defun guix-list-get-column-format (entry-type)
+ "Return column format for ENTRY-TYPE."
+ (guix-get-key-val guix-list-column-format entry-type))
+
+(defun guix-list-get-displayed-params (entry-type)
+ "Return list of parameters of ENTRY-TYPE that should be displayed."
+ (mapcar #'car
+ (guix-list-get-column-format entry-type)))
+
+(defun guix-list-get-sort-key (entry-type param &optional invert)
+ "Return suitable sort key for `tabulated-list-sort-key'.
+Define column title by ENTRY-TYPE and PARAM. If INVERT is
+non-nil, invert the sort."
+ (when (memq param (guix-list-get-displayed-params entry-type))
+ (cons (guix-list-get-param-title entry-type param) invert)))
+
+(defun guix-list-sort-numerically (column a b)
+ "Compare COLUMN of tabulated entries A and B numerically.
+It is a sort predicate for `tabulated-list-format'.
+Return non-nil, if B is bigger than A."
+ (cl-flet ((num (entry)
+ (string-to-number (aref (cadr entry) column))))
+ (> (num b) (num a))))
+
+(defun guix-list-make-tabulated-vector (entry-type fun)
+ "Call FUN on each column specification for ENTRY-TYPE.
+
+FUN is called with 2 argument: parameter name and column
+specification (see `guix-list-column-format').
+
+Return a vector made of values of FUN calls."
+ (apply #'vector
+ (mapcar (lambda (col-spec)
+ (funcall fun (car col-spec) (cdr col-spec)))
+ (guix-list-get-column-format entry-type))))
+
+(defun guix-list-get-list-format (entry-type)
+ "Return ENTRY-TYPE list specification for `tabulated-list-format'."
+ (guix-list-make-tabulated-vector
+ entry-type
+ (lambda (param spec)
+ (cons (guix-list-get-param-title entry-type param)
+ spec))))
+
+(defun guix-list-insert-entries (entries entry-type)
+ "Display ENTRIES of ENTRY-TYPE in the current list buffer.
+ENTRIES should have a form of `guix-entries'."
+ (setq tabulated-list-entries
+ (guix-list-get-tabulated-entries entries entry-type))
+ (tabulated-list-print))
+
+(defun guix-list-get-tabulated-entries (entries entry-type)
+ "Return list of values of ENTRY-TYPE for `tabulated-list-entries'.
+Values are taken from ENTRIES which should have the form of
+`guix-entries'."
+ (mapcar (lambda (entry)
+ (list (guix-get-key-val entry 'id)
+ (guix-list-get-tabulated-entry entry entry-type)))
+ entries))
+
+(defun guix-list-get-tabulated-entry (entry entry-type)
+ "Return array of values for `tabulated-list-entries'.
+Parameters are taken from ENTRY of ENTRY-TYPE."
+ (guix-list-make-tabulated-vector
+ entry-type
+ (lambda (param _)
+ (let ((val (guix-get-key-val entry param))
+ (fun (guix-get-key-val guix-list-column-value-methods
+ entry-type param)))
+ (if (and val fun)
+ (funcall fun val entry)
+ (guix-get-string val))))))
+
+(defun guix-list-get-one-line (str &optional _)
+ "Return one-line string from a multi-line STR."
+ (guix-get-one-line str))
+
+(defun guix-list-get-time (seconds &optional _)
+ "Return formatted time string from SECONDS."
+ (guix-get-time-string seconds))
+
+(defun guix-list-get-file-path (path &optional _)
+ "Return PATH button specification for `tabulated-list-entries'."
+ (list path
+ 'face 'guix-list-file-path
+ 'action (lambda (btn) (find-file (button-label btn)))
+ 'follow-link t
+ 'help-echo "Find file"))
+
+(defun guix-list-current-id ()
+ "Return ID of the current entry."
+ (or (tabulated-list-get-id)
+ (user-error "No entry here")))
+
+(defun guix-list-current-entry ()
+ "Return alist of the current entry info."
+ (guix-get-entry-by-id (guix-list-current-id) guix-entries))
+
+(defun guix-list-for-each-line (fun &rest args)
+ "Call FUN with ARGS for each entry line."
+ (or (derived-mode-p 'guix-list-mode)
+ (error "The current buffer is not in Guix List mode"))
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (apply fun args)
+ (forward-line))))
+
+(defun guix-list-fold-lines (fun init)
+ "Fold over entry lines in the current list buffer.
+Call FUN with RESULT as argument for each line, using INIT as
+the initial value of RESULT. Return the final result."
+ (let ((res init))
+ (guix-list-for-each-line
+ (lambda () (setq res (funcall fun res))))
+ res))
+
+\f
+;;; Marking and sorting
+
+(defvar-local guix-list-marked nil
+ "List of the marked entries.
+Each element of the list has a form:
+
+ (ID MARK-NAME . ARGS)
+
+ID is an entry ID.
+MARK-NAME is a symbol from `guix-list-mark-alist'.
+ARGS is a list of additional values.")
+
+(defvar guix-list-mark-alist
+ '((empty . ?\s)
+ (general . ?*))
+ "Alist of available mark names and mark characters.")
+
+(defsubst guix-list-get-mark (name)
+ "Return mark character by its NAME."
+ (or (guix-get-key-val guix-list-mark-alist name)
+ (error "Mark '%S' not found" name)))
+
+(defsubst guix-list-get-mark-string (name)
+ "Return mark string by its NAME."
+ (string (guix-list-get-mark name)))
+
+(defun guix-list-current-mark ()
+ "Return mark character of the current line."
+ (char-after (line-beginning-position)))
+
+(defun guix-list-get-marked (&rest mark-names)
+ "Return list of specs of entries marked with any mark from MARK-NAMES.
+Entry specs are elements from `guix-list-marked' list.
+If MARK-NAMES are not specified, use all marks from
+`guix-list-mark-alist' except the `empty' one."
+ (or mark-names
+ (setq mark-names
+ (delq 'empty
+ (mapcar #'car guix-list-mark-alist))))
+ (cl-remove-if-not (lambda (assoc)
+ (memq (cadr assoc) mark-names))
+ guix-list-marked))
+
+(defun guix-list-get-marked-args (mark-name)
+ "Return list of (ID . ARGS) elements from lines marked with MARK-NAME.
+See `guix-list-marked' for the meaning of ARGS."
+ (mapcar (lambda (spec)
+ (let ((id (car spec))
+ (args (cddr spec)))
+ (cons id args)))
+ (guix-list-get-marked mark-name)))
+
+(defun guix-list-get-marked-id-list (&rest mark-names)
+ "Return list of IDs of entries marked with any mark from MARK-NAMES.
+See `guix-list-get-marked' for details."
+ (mapcar #'car (apply #'guix-list-get-marked mark-names)))
+
+(defun guix-list-mark (mark-name &optional advance &rest args)
+ "Put a mark on the current line.
+Also add the current entry to `guix-list-marked' using its ID and ARGS.
+MARK-NAME is a symbol from `guix-list-mark-alist'.
+If ADVANCE is non-nil, move forward by one line after marking.
+Interactively, put a general mark and move to the next line."
+ (interactive '(general t))
+ (let ((id (guix-list-current-id)))
+ (if (eq mark-name 'empty)
+ (setq guix-list-marked (assq-delete-all id guix-list-marked))
+ (let ((assoc (assq id guix-list-marked))
+ (val (cons mark-name args)))
+ (if assoc
+ (setcdr assoc val)
+ (push (cons id val) guix-list-marked)))))
+ (tabulated-list-put-tag (guix-list-get-mark-string mark-name)
+ advance))
+
+(defun guix-list-mark-all (mark-name)
+ "Mark all lines with MARK-NAME mark.
+MARK-NAME is a symbol from `guix-list-mark-alist'.
+Interactively, put a general mark on all lines."
+ (interactive '(general))
+ (guix-list-for-each-line #'guix-list-mark mark-name))
+
+(defun guix-list-unmark ()
+ "Unmark the current line and move to the next line."
+ (interactive)
+ (guix-list-mark 'empty t))
+
+(defun guix-list-unmark-backward ()
+ "Move up one line and unmark it."
+ (interactive)
+ (forward-line -1)
+ (guix-list-mark 'empty))
+
+(defun guix-list-unmark-all ()
+ "Unmark all lines."
+ (interactive)
+ (guix-list-mark-all 'empty))
+
+(defun guix-list-restore-marks ()
+ "Put marks according to `guix-list-mark-alist'."
+ (guix-list-for-each-line
+ (lambda ()
+ (let ((mark-name (car (guix-get-key-val guix-list-marked
+ (guix-list-current-id)))))
+ (tabulated-list-put-tag
+ (guix-list-get-mark-string (or mark-name 'empty)))))))
+
+(defun guix-list-sort (&optional n)
+ "Sort guix list entries by the column at point.
+With a numeric prefix argument N, sort the Nth column.
+Same as `tabulated-list-sort', but also restore marks after sorting."
+ (interactive "P")
+ (tabulated-list-sort n)
+ (guix-list-restore-marks))
+
+\f
+(defvar guix-list-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map tabulated-list-mode-map)
+ (define-key map (kbd "m") 'guix-list-mark)
+ (define-key map (kbd "*") 'guix-list-mark)
+ (define-key map (kbd "M") 'guix-list-mark-all)
+ (define-key map (kbd "u") 'guix-list-unmark)
+ (define-key map (kbd "U") 'guix-list-unmark-all)
+ (define-key map (kbd "DEL") 'guix-list-unmark-backward)
+ (define-key map [remap tabulated-list-sort] 'guix-list-sort)
+ map)
+ "Parent keymap for list buffers.")
+
+(define-derived-mode guix-list-mode tabulated-list-mode "Guix-List"
+ "Parent mode for displaying information in list buffers."
+ (setq tabulated-list-padding 2))
+
+(defmacro guix-list-define-entry-type (entry-type &rest args)
+ "Define common stuff for displaying ENTRY-TYPE entries in list buffers.
+
+Remaining argument (ARGS) should have a form [KEYWORD VALUE] ... The
+following keywords are available:
+
+ - `:sort-key' - default sort key for the tabulated list buffer.
+
+ - `:invert-sort' - if non-nil, invert initial sort.
+
+ - `:marks' - default value for the defined
+ `guix-ENTRY-TYPE-mark-alist' variable.
+
+This macro defines the following functions:
+
+ - `guix-ENTRY-TYPE-describe' - display marked entries in info buffer.
+
+ - `guix-ENTRY-TYPE-mark-MARK-NAME' functions for each mark
+ specified in `:marks' argument."
+ (let* ((entry-type-str (symbol-name entry-type))
+ (entry-str (concat entry-type-str " entries"))
+ (prefix (concat "guix-" entry-type-str "-list"))
+ (mode-str (concat prefix "-mode"))
+ (init-fun (intern (concat prefix "-mode-initialize")))
+ (describe-fun (intern (concat prefix "-describe")))
+ (marks-var (intern (concat prefix "-mark-alist")))
+ (marks-val nil)
+ (sort-key nil)
+ (invert-sort nil))
+
+ ;; Process the keyword args.
+ (while (keywordp (car args))
+ (pcase (pop args)
+ (`:sort-key (setq sort-key (pop args)))
+ (`:invert-sort (setq invert-sort (pop args)))
+ (`:marks (setq marks-val (pop args)))
+ (_ (pop args))))
+
+ `(progn
+ (defvar ,marks-var ',marks-val
+ ,(concat "Alist of additional marks for `" mode-str "'.\n"
+ "Marks from this list are added to `guix-list-mark-alist'."))
+
+ ,@(mapcar (lambda (mark-spec)
+ (let* ((mark-name (car mark-spec))
+ (mark-name-str (symbol-name mark-name)))
+ `(defun ,(intern (concat prefix "-mark-" mark-name-str "-simple")) ()
+ ,(concat "Put '" mark-name-str "' mark and move to the next line.\n"
+ "Also add the current entry to `guix-list-marked'.")
+ (interactive)
+ (guix-list-mark ',mark-name t))))
+ marks-val)
+
+ (defun ,describe-fun (&optional arg)
+ ,(concat "Describe " entry-str " marked with a general mark.\n"
+ "If no entry is marked, describe the current " entry-type-str ".\n"
+ "With prefix (if ARG is non-nil), describe the " entry-str "\n"
+ "marked with any mark.")
+ (interactive "P")
+ (let* ((ids (or (apply #'guix-list-get-marked-id-list
+ (unless arg '(general)))
+ (list (guix-list-current-id))))
+ (count (length ids)))
+ (when (or (<= count guix-list-describe-warning-count)
+ (y-or-n-p (format "Do you really want to describe %d entries? "
+ count)))
+ (,(intern (concat "guix-" entry-type-str "-info-get-show"))
+ 'id ids))))
+
+ (defun ,init-fun ()
+ ,(concat "Initial settings for `" mode-str "'.")
+ ,(when sort-key
+ `(setq tabulated-list-sort-key
+ (guix-list-get-sort-key
+ ',entry-type ',sort-key ,invert-sort)))
+ (setq tabulated-list-format
+ (guix-list-get-list-format ',entry-type))
+ (setq-local guix-list-mark-alist
+ (append guix-list-mark-alist ,marks-var))
+ (tabulated-list-init-header)))))
+
+(put 'guix-list-define-entry-type 'lisp-indent-function 'defun)
+
+\f
+;;; Displaying packages
+
+(guix-define-buffer-type list package)
+
+(guix-list-define-entry-type package
+ :sort-key name
+ :marks ((install . ?I)
+ (upgrade . ?U)
+ (delete . ?D)))
+
+(defface guix-package-list-obsolete
+ '((t :inherit guix-package-info-obsolete))
+ "Face used if a package is obsolete."
+ :group 'guix-package-list)
+
+(defcustom guix-package-list-generation-marking-enabled nil
+ "If non-nil, allow putting marks in a list with 'generation packages'.
+
+By default this is disabled, because it may be confusing. For
+example a package is installed in some generation, so a user can
+mark it for deletion in the list of packages from this
+generation, but the package may not be installed in the latest
+generation, so actually it cannot be deleted.
+
+If you managed to understand the explanation above or if you
+really know what you do or if you just don't care, you can set
+this variable to t. It should not do much harm anyway (most
+likely)."
+ :type 'boolean
+ :group 'guix-package-list)
+
+(let ((map guix-package-list-mode-map))
+ (define-key map (kbd "RET") 'guix-package-list-describe)
+ (define-key map (kbd "x") 'guix-package-list-execute)
+ (define-key map (kbd "i") 'guix-package-list-mark-install)
+ (define-key map (kbd "^") 'guix-package-list-mark-upgrade)
+ (define-key map (kbd "d") 'guix-package-list-mark-delete))
+
+(defun guix-package-list-get-name (name entry)
+ "Return NAME of the package ENTRY.
+Colorize it with `guix-package-list-obsolete' if needed."
+ (guix-get-string name
+ (when (guix-get-key-val entry 'obsolete)
+ 'guix-package-list-obsolete)))
+
+(defun guix-package-list-get-installed-outputs (installed &optional _)
+ "Return string with outputs from INSTALLED entries."
+ (guix-get-string
+ (mapcar (lambda (entry)
+ (guix-get-key-val entry 'output))
+ installed)))
+
+(defun guix-package-list-marking-check ()
+ "Signal an error if marking is disabled for the current buffer."
+ (when (and (not guix-package-list-generation-marking-enabled)
+ (derived-mode-p 'guix-package-list-mode)
+ (eq guix-search-type 'generation))
+ (error "Action marks are disabled for lists of 'generation packages'")))
+
+(defun guix-package-list-mark-install (&optional arg)
+ "Mark the current package for installation and move to the next line.
+With ARG, prompt for the outputs to install (several outputs may
+be separated with \",\")."
+ (interactive "P")
+ (guix-package-list-marking-check)
+ (let* ((entry (guix-list-current-entry))
+ (available (guix-get-key-val entry 'outputs))
+ (installed (guix-get-installed-outputs entry))
+ (to-install (if arg
+ (guix-completing-read-multiple
+ "Output(s) to install: " available nil t)
+ '("out")))
+ (to-install (cl-set-difference to-install installed
+ :test #'string=)))
+ (if to-install
+ (apply #'guix-list-mark 'install t to-install)
+ (user-error "This package is already installed"))))
+
+(defun guix-package-list-mark-delete (&optional arg)
+ "Mark the current package for deletion and move to the next line.
+With ARG, prompt for the outputs to delete (several outputs may
+be separated with \",\")."
+ (interactive "P")
+ (guix-package-list-marking-check)
+ (let* ((entry (guix-list-current-entry))
+ (installed (guix-get-installed-outputs entry)))
+ (or installed
+ (user-error "This package is not installed"))
+ (let ((to-delete (when arg
+ (guix-completing-read-multiple
+ "Output(s) to delete: " installed nil t))))
+ (if to-delete
+ (apply #'guix-list-mark 'delete t to-delete)
+ (guix-package-list-mark-delete-simple)))))
+
+(defun guix-package-list-mark-upgrade ()
+ "Mark the current package for upgrading and move to the next line."
+ (interactive)
+ (guix-package-list-marking-check)
+ (let ((entry (guix-list-current-entry)))
+ (or (guix-get-installed-outputs entry)
+ (user-error "This package is not installed"))
+ (when (or (guix-get-key-val entry 'obsolete)
+ (y-or-n-p "This package is not obsolete. Try to upgrade it anyway? "))
+ (guix-package-list-mark-upgrade-simple))))
+
+(defun guix-package-list-execute ()
+ "Perform actions on the marked packages."
+ (interactive)
+ (let ((actions (delq nil
+ (mapcar #'guix-package-list-make-action
+ '(install delete upgrade)))))
+ (if actions
+ (apply #'guix-process-package-actions actions)
+ (user-error "No operations specified"))))
+
+(defun guix-package-list-make-action (action-type)
+ "Return action specification for the packages marked with ACTION-TYPE.
+Return nil, if there are no packages marked with ACTION-TYPE.
+The specification is suitable for `guix-process-package-actions'."
+ (let ((specs (guix-list-get-marked-args action-type)))
+ (and specs (cons action-type specs))))
+
+\f
+;;; Displaying generations
+
+(guix-define-buffer-type list generation)
+
+(guix-list-define-entry-type generation
+ :sort-key number
+ :invert-sort t
+ :marks ((delete . ?D)))
+
+(let ((map guix-generation-list-mode-map))
+ (define-key map (kbd "RET") 'guix-generation-list-show-packages)
+ (define-key map (kbd "i") 'guix-generation-list-describe)
+ (define-key map (kbd "d") 'guix-generation-list-mark-delete-simple))
+
+(defun guix-generation-list-show-packages ()
+ "List installed packages for the generation at point."
+ (interactive)
+ (guix-package-list-get-show 'generation (guix-list-current-id)))
+
+(provide 'guix-list)
+
+;;; guix-list.el ends here
--- /dev/null
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Information about packages and generations is passed to the elisp
+;; side in the form of alists of parameters (such as ‘name’ or
+;; ‘version’) and their values. These alists are called "entries" in
+;; this code. So to distinguish, just "package" in the name of a
+;; function means a guile object ("package" record) while
+;; "package entry" means alist of package parameters and values (see
+;; ‘package-param-alist’).
+;;
+;; "Entry" is probably not the best name for such alists, because there
+;; already exists "manifest-entry" which has nothing to do with the
+;; "entry" described above. Do not be confused :)
+
+;; ‘get-entries’ function is the “entry point” for the elisp side to get
+;; information about packages and generations.
+
+;; Since name/version pair is not necessarily unique, we use
+;; `object-address' to identify a package (for ‘id’ parameter), if
+;; possible. However for the obsolete packages (that can be found in
+;; installed manifest but not in a package directory), ‘id’ parameter is
+;; still "name-version" string. So ‘id’ package parameter in the code
+;; below is either an object-address number or a full-name string.
+;;
+;; Important: as object addresses live only during guile session, elisp
+;; part should take care about updating information after "Guix REPL" is
+;; restarted (TODO!)
+;;
+;; ‘installed’ parameter of a package entry contains information about
+;; installed outputs. It is a list of "installed entries" (see
+;; ‘package-installed-param-alist’).
+
+;; To speed-up the process of getting information, the following
+;; auxiliary variables are used:
+;;
+;; - `%packages' - VHash of "package address"/"package" pairs.
+;;
+;; - `%package-table' - Hash table of
+;; "name+version key"/"list of packages" pairs.
+;;
+;; - `%current-manifest-entries-table' - Hash table of
+;; "name+version key"/"list of manifest entries" pairs. This variable
+;; is set by `set-current-manifest-maybe!' when it is needed.
+
+;;; Code:
+
+(use-modules
+ (ice-9 vlist)
+ (ice-9 match)
+ (srfi srfi-1)
+ (srfi srfi-11)
+ (srfi srfi-19)
+ (srfi srfi-26)
+ (guix)
+ (guix packages)
+ (guix profiles)
+ (guix licenses)
+ (guix utils)
+ (guix ui)
+ (guix scripts package)
+ (gnu packages))
+
+(define-syntax-rule (first-or-false lst)
+ (and (not (null? lst))
+ (first lst)))
+
+(define full-name->name+version package-name->name+version)
+(define (name+version->full-name name version)
+ (string-append name "-" version))
+
+(define* (make-package-specification name #:optional version output)
+ (let ((full-name (if version
+ (name+version->full-name name version)
+ name)))
+ (if output
+ (string-append full-name ":" output)
+ full-name)))
+
+(define name+version->key cons)
+(define key->name+version car+cdr)
+
+(define %current-manifest #f)
+(define %current-manifest-entries-table #f)
+
+(define %packages
+ (fold-packages (lambda (pkg res)
+ (vhash-consq (object-address pkg) pkg res))
+ vlist-null))
+
+(define %package-table
+ (let ((table (make-hash-table (vlist-length %packages))))
+ (vlist-for-each
+ (lambda (elem)
+ (match elem
+ ((address . pkg)
+ (let* ((key (name+version->key (package-name pkg)
+ (package-version pkg)))
+ (ref (hash-ref table key)))
+ (hash-set! table key
+ (if ref (cons pkg ref) (list pkg)))))))
+ %packages)
+ table))
+
+;; FIXME get rid of this function!
+(define (set-current-manifest-maybe! profile)
+ (define (manifest-entries->hash-table entries)
+ (let ((entries-table (make-hash-table (length entries))))
+ (for-each (lambda (entry)
+ (let* ((key (name+version->key
+ (manifest-entry-name entry)
+ (manifest-entry-version entry)))
+ (ref (hash-ref entries-table key)))
+ (hash-set! entries-table key
+ (if ref (cons entry ref) (list entry)))))
+ entries)
+ entries-table))
+
+ (when profile
+ (let ((manifest (profile-manifest profile)))
+ (unless (and (manifest? %current-manifest)
+ (equal? manifest %current-manifest))
+ (set! %current-manifest manifest)
+ (set! %current-manifest-entries-table
+ (manifest-entries->hash-table
+ (manifest-entries manifest)))))))
+
+(define (manifest-entries-by-name+version name version)
+ (or (hash-ref %current-manifest-entries-table
+ (name+version->key name version))
+ '()))
+
+(define (packages-by-name+version name version)
+ (or (hash-ref %package-table
+ (name+version->key name version))
+ '()))
+
+(define (packages-by-full-name full-name)
+ (call-with-values
+ (lambda () (full-name->name+version full-name))
+ packages-by-name+version))
+
+(define (package-by-address address)
+ (and=> (vhash-assq address %packages)
+ cdr))
+
+(define (packages-by-id id)
+ (if (integer? id)
+ (let ((pkg (package-by-address id)))
+ (if pkg (list pkg) '()))
+ (packages-by-full-name id)))
+
+(define (package-by-id id)
+ (first-or-false (packages-by-id id)))
+
+(define (newest-package-by-id id)
+ (and=> (id->name+version id)
+ (lambda (name)
+ (first-or-false (find-best-packages-by-name name #f)))))
+
+(define (id->name+version id)
+ (if (integer? id)
+ (and=> (package-by-address id)
+ (lambda (pkg)
+ (values (package-name pkg)
+ (package-version pkg))))
+ (full-name->name+version id)))
+
+(define (fold-manifest-entries proc init)
+ "Fold over `%current-manifest-entries-table'.
+Call (PROC NAME VERSION ENTRIES RESULT) for each element of the hash
+table, using INIT as the initial value of RESULT."
+ (hash-fold (lambda (key entries res)
+ (let-values (((name version) (key->name+version key)))
+ (proc name version entries res)))
+ init
+ %current-manifest-entries-table))
+
+(define (fold-object proc init obj)
+ (fold proc init
+ (if (list? obj) obj (list obj))))
+
+(define* (object-transformer param-alist #:optional (params '()))
+ "Return function for transforming an object into alist of parameters/values.
+
+PARAM-ALIST is alist of available object parameters (symbols) and functions
+returning values of these parameters. Each function is called with object as
+a single argument.
+
+PARAMS is list of parameters from PARAM-ALIST that should be returned by a
+resulting function. If PARAMS is not specified or is an empty list, use all
+available parameters.
+
+Example:
+
+ (let ((alist `((plus1 . ,1+) (minus1 . ,1-) (mul2 . ,(cut * 2 <>))))
+ (number->alist (object-transformer alist '(plus1 mul2))))
+ (number->alist 8))
+ =>
+ ((plus1 . 9) (mul2 . 16))
+"
+ (let ((alist (let ((use-all-params (null? params)))
+ (filter-map (match-lambda
+ ((param . fun)
+ (and (or use-all-params
+ (memq param params))
+ (cons param fun)))
+ (_ #f))
+ param-alist))))
+ (lambda (object)
+ (map (match-lambda
+ ((param . fun)
+ (cons param (fun object))))
+ alist))))
+
+(define package-installed-param-alist
+ (list
+ (cons 'output manifest-entry-output)
+ (cons 'path manifest-entry-item)
+ (cons 'dependencies manifest-entry-dependencies)))
+
+(define manifest-entry->installed-entry
+ (object-transformer package-installed-param-alist))
+
+(define (manifest-entries->installed-entries entries)
+ (map manifest-entry->installed-entry entries))
+
+(define (installed-entries-by-name+version name version)
+ (manifest-entries->installed-entries
+ (manifest-entries-by-name+version name version)))
+
+(define (installed-entries-by-package package)
+ (installed-entries-by-name+version (package-name package)
+ (package-version package)))
+
+(define (package-inputs-names inputs)
+ "Return list of full names of the packages from package INPUTS."
+ (filter-map (match-lambda
+ ((_ (? package? package))
+ (package-full-name package))
+ (_ #f))
+ inputs))
+
+(define (package-license-names package)
+ "Return list of license names of the PACKAGE."
+ (fold-object (lambda (license res)
+ (if (license? license)
+ (cons (license-name license) res)
+ res))
+ '()
+ (package-license package)))
+
+(define (package-unique? package)
+ "Return #t if PACKAGE is a single package with such name/version."
+ (null? (cdr (packages-by-name+version (package-name package)
+ (package-version package)))))
+
+(define package-param-alist
+ (list
+ (cons 'id object-address)
+ (cons 'name package-name)
+ (cons 'version package-version)
+ (cons 'license package-license-names)
+ (cons 'synopsis package-synopsis)
+ (cons 'description package-description)
+ (cons 'home-url package-home-page)
+ (cons 'outputs package-outputs)
+ (cons 'non-unique (negate package-unique?))
+ (cons 'inputs (lambda (pkg) (package-inputs-names
+ (package-inputs pkg))))
+ (cons 'native-inputs (lambda (pkg) (package-inputs-names
+ (package-native-inputs pkg))))
+ (cons 'propagated-inputs (lambda (pkg) (package-inputs-names
+ (package-propagated-inputs pkg))))
+ (cons 'location (lambda (pkg) (location->string
+ (package-location pkg))))
+ (cons 'installed installed-entries-by-package)))
+
+(define (package-param package param)
+ "Return the value of a PACKAGE PARAM."
+ (define (accessor param)
+ (and=> (assq param package-param-alist)
+ cdr))
+ (and=> (accessor param)
+ (cut <> package)))
+
+(define (matching-package-entries ->entry predicate)
+ "Return list of package entries for the matching packages.
+PREDICATE is called on each package."
+ (fold-packages (lambda (pkg res)
+ (if (predicate pkg)
+ (cons (->entry pkg) res)
+ res))
+ '()))
+
+(define (make-obsolete-package-entry name version entries)
+ "Return package entry for an obsolete package with NAME and VERSION.
+ENTRIES is a list of manifest entries used to get installed info."
+ `((id . ,(name+version->full-name name version))
+ (name . ,name)
+ (version . ,version)
+ (outputs . ,(map manifest-entry-output entries))
+ (obsolete . #t)
+ (installed . ,(manifest-entries->installed-entries entries))))
+
+(define (package-entries-by-name+version ->entry name version)
+ "Return list of package entries for packages with NAME and VERSION."
+ (let ((packages (packages-by-name+version name version)))
+ (if (null? packages)
+ (let ((entries (manifest-entries-by-name+version name version)))
+ (if (null? entries)
+ '()
+ (list (make-obsolete-package-entry name version entries))))
+ (map ->entry packages))))
+
+(define (package-entries-by-spec profile ->entry spec)
+ "Return list of package entries for packages with name specification SPEC."
+ (set-current-manifest-maybe! profile)
+ (let-values (((name version)
+ (full-name->name+version spec)))
+ (if version
+ (package-entries-by-name+version ->entry name version)
+ (matching-package-entries
+ ->entry
+ (lambda (pkg) (string=? name (package-name pkg)))))))
+
+(define (package-entries-by-regexp profile ->entry regexp match-params)
+ "Return list of package entries for packages matching REGEXP string.
+MATCH-PARAMS is a list of parameters that REGEXP can match."
+ (define (package-match? package regexp)
+ (any (lambda (param)
+ (let ((val (package-param package param)))
+ (and (string? val) (regexp-exec regexp val))))
+ match-params))
+
+ (set-current-manifest-maybe! profile)
+ (let ((re (make-regexp regexp regexp/icase)))
+ (matching-package-entries ->entry (cut package-match? <> re))))
+
+(define (package-entries-by-ids profile ->entry ids)
+ "Return list of package entries for packages matching KEYS.
+IDS may be an object-address, a full-name or a list of such elements."
+ (set-current-manifest-maybe! profile)
+ (fold-object
+ (lambda (id res)
+ (if (integer? id)
+ (let ((pkg (package-by-address id)))
+ (if pkg
+ (cons (->entry pkg) res)
+ res))
+ (let ((entries (package-entries-by-spec #f ->entry id)))
+ (if (null? entries)
+ res
+ (append res entries)))))
+ '()
+ ids))
+
+(define (newest-available-package-entries profile ->entry)
+ "Return list of package entries for the newest available packages."
+ (set-current-manifest-maybe! profile)
+ (vhash-fold (lambda (name elem res)
+ (match elem
+ ((version newest pkgs ...)
+ (cons (->entry newest) res))))
+ '()
+ (find-newest-available-packages)))
+
+(define (all-available-package-entries profile ->entry)
+ "Return list of package entries for all available packages."
+ (set-current-manifest-maybe! profile)
+ (matching-package-entries ->entry (const #t)))
+
+(define (manifest-package-entries ->entry)
+ "Return list of package entries for the current manifest."
+ (fold-manifest-entries
+ (lambda (name version entries res)
+ ;; We don't care about duplicates for the list of
+ ;; installed packages, so just take any package (car)
+ ;; matching name+version
+ (cons (car (package-entries-by-name+version ->entry name version))
+ res))
+ '()))
+
+(define (installed-package-entries profile ->entry)
+ "Return list of package entries for all installed packages."
+ (set-current-manifest-maybe! profile)
+ (manifest-package-entries ->entry))
+
+(define (generation-package-entries profile ->entry generation)
+ "Return list of package entries for packages from GENERATION."
+ (set-current-manifest-maybe!
+ (generation-file-name profile generation))
+ (manifest-package-entries ->entry))
+
+(define (obsolete-package-entries profile _)
+ "Return list of package entries for obsolete packages."
+ (set-current-manifest-maybe! profile)
+ (fold-manifest-entries
+ (lambda (name version entries res)
+ (let ((packages (packages-by-name+version name version)))
+ (if (null? packages)
+ (cons (make-obsolete-package-entry name version entries) res)
+ res)))
+ '()))
+
+\f
+;;; Generation entries
+
+(define (profile-generations profile)
+ "Return list of generations for PROFILE."
+ (let ((generations (generation-numbers profile)))
+ (if (equal? generations '(0))
+ '()
+ generations)))
+
+(define (generation-param-alist profile)
+ "Return alist of generation parameters and functions for PROFILE."
+ (list
+ (cons 'id identity)
+ (cons 'number identity)
+ (cons 'prev-number (cut previous-generation-number profile <>))
+ (cons 'path (cut generation-file-name profile <>))
+ (cons 'time (lambda (gen)
+ (time-second (generation-time profile gen))))))
+
+(define (matching-generation-entries profile ->entry predicate)
+ "Return list of generation entries for the matching generations.
+PREDICATE is called on each generation."
+ (filter-map (lambda (gen)
+ (and (predicate gen) (->entry gen)))
+ (profile-generations profile)))
+
+(define (last-generation-entries profile ->entry number)
+ "Return list of last NUMBER generation entries.
+If NUMBER is 0 or less, return all generation entries."
+ (let ((generations (profile-generations profile))
+ (number (if (<= number 0) +inf.0 number)))
+ (map ->entry
+ (if (> (length generations) number)
+ (list-head (reverse generations) number)
+ generations))))
+
+(define (all-generation-entries profile ->entry)
+ "Return list of all generation entries."
+ (last-generation-entries profile ->entry +inf.0))
+
+(define (generation-entries-by-ids profile ->entry ids)
+ "Return list of generation entries for generations matching IDS.
+IDS is a list of generation numbers."
+ (matching-generation-entries profile ->entry (cut memq <> ids)))
+
+\f
+;;; Getting package/generation entries
+
+(define %package-entries-functions
+ (alist->vhash
+ `((id . ,package-entries-by-ids)
+ (name . ,package-entries-by-spec)
+ (regexp . ,package-entries-by-regexp)
+ (all-available . ,all-available-package-entries)
+ (newest-available . ,newest-available-package-entries)
+ (installed . ,installed-package-entries)
+ (obsolete . ,obsolete-package-entries)
+ (generation . ,generation-package-entries))
+ hashq))
+
+(define %generation-entries-functions
+ (alist->vhash
+ `((id . ,generation-entries-by-ids)
+ (last . ,last-generation-entries)
+ (all . ,all-generation-entries))
+ hashq))
+
+(define (get-entries profile params entry-type search-type search-vals)
+ "Return list of entries.
+ENTRY-TYPE and SEARCH-TYPE define a search function that should be
+applied to PARAMS and VALS."
+ (let-values (((vhash ->entry)
+ (case entry-type
+ ((package)
+ (values %package-entries-functions
+ (object-transformer
+ package-param-alist params)))
+ ((generation)
+ (values %generation-entries-functions
+ (object-transformer
+ (generation-param-alist profile) params)))
+ (else (format (current-error-port)
+ "Wrong entry type '~a'" entry-type)))))
+ (match (vhash-assq search-type vhash)
+ ((key . fun)
+ (apply fun profile ->entry search-vals))
+ (_ '()))))
+
+\f
+;;; Actions
+
+(define* (package->manifest-entry* package #:optional output)
+ (and package
+ (begin
+ (check-package-freshness package)
+ (package->manifest-entry package output))))
+
+(define* (make-install-manifest-entries id #:optional output)
+ (package->manifest-entry* (package-by-id id) output))
+
+(define* (make-upgrade-manifest-entries id #:optional output)
+ (package->manifest-entry* (newest-package-by-id id) output))
+
+(define* (make-manifest-pattern id #:optional output)
+ "Make manifest pattern from a package ID and OUTPUT."
+ (let-values (((name version)
+ (id->name+version id)))
+ (and name version
+ (manifest-pattern
+ (name name)
+ (version version)
+ (output output)))))
+
+(define (convert-action-pattern pattern proc)
+ "Convert action PATTERN into a list of objects returned by PROC.
+PROC is called: (PROC ID) or (PROC ID OUTPUT)."
+ (match pattern
+ ((id . outputs)
+ (if (null? outputs)
+ (let ((obj (proc id)))
+ (if obj (list obj) '()))
+ (filter-map (cut proc id <>)
+ outputs)))
+ (_ '())))
+
+(define (convert-action-patterns patterns proc)
+ (append-map (cut convert-action-pattern <> proc)
+ patterns))
+
+(define* (process-package-actions
+ profile #:key (install '()) (upgrade '()) (remove '())
+ (use-substitutes? #t) dry-run?)
+ "Perform package actions.
+
+INSTALL, UPGRADE, REMOVE are lists of 'package action patterns'.
+Each pattern should have the following form:
+
+ (ID . OUTPUTS)
+
+ID is an object address or a full-name of a package.
+OUTPUTS is a list of package outputs (may be an empty list)."
+ (format #t "The process begins ...~%")
+ (let* ((install (append
+ (convert-action-patterns
+ install make-install-manifest-entries)
+ (convert-action-patterns
+ upgrade make-upgrade-manifest-entries)))
+ (remove (convert-action-patterns remove make-manifest-pattern))
+ (transaction (manifest-transaction (install install)
+ (remove remove)))
+ (manifest (profile-manifest profile))
+ (new-manifest (manifest-perform-transaction
+ manifest transaction)))
+ (unless (and (null? install) (null? remove))
+ (let* ((store (open-connection))
+ (derivation (run-with-store
+ store (profile-derivation new-manifest)))
+ (derivations (list derivation))
+ (new-profile (derivation->output-path derivation)))
+ (set-build-options store
+ #:use-substitutes? use-substitutes?)
+ (manifest-show-transaction store manifest transaction
+ #:dry-run? dry-run?)
+ (show-what-to-build store derivations
+ #:use-substitutes? use-substitutes?
+ #:dry-run? dry-run?)
+ (unless dry-run?
+ (let ((name (generation-file-name
+ profile
+ (+ 1 (generation-number profile)))))
+ (and (build-derivations store derivations)
+ (let* ((entries (manifest-entries new-manifest))
+ (count (length entries)))
+ (switch-symlinks name new-profile)
+ (switch-symlinks profile name)
+ (format #t (N_ "~a package in profile~%"
+ "~a packages in profile~%"
+ count)
+ count)))))))))
+
--- /dev/null
+;;; guix-utils.el --- General utility functions
+
+;; Copyright © 2014 Alex Kost <alezost@gmail.com>
+
+;; This file is part of GNU Guix.
+
+;; GNU Guix is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Guix is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file provides auxiliary general functions for guix.el package.
+
+;;; Code:
+
+;; (require 'cl-lib)
+
+(defvar guix-true-string "Yes")
+(defvar guix-false-string "–")
+(defvar guix-list-separator ", ")
+
+(defvar guix-time-format "%F %T"
+ "String used to format time values.
+For possible formats, see `format-time-string'.")
+
+(defun guix-get-string (val &optional face)
+ "Convert VAL into a string and return it.
+
+VAL can be an expression of any type.
+If VAL is t/nil, it is replaced with
+`guix-true-string'/`guix-false-string'.
+If VAL is list, its elements are concatenated using
+`guix-list-separator'.
+
+If FACE is non-nil, propertize returned string with this FACE."
+ (let ((str (cond
+ ((stringp val) val)
+ ((null val) guix-false-string)
+ ((eq t val) guix-true-string)
+ ((numberp val) (number-to-string val))
+ ((listp val) (mapconcat #'guix-get-string
+ val guix-list-separator))
+ (t (prin1-to-string val)))))
+ (if (and val face)
+ (propertize str 'face face)
+ str)))
+
+(defun guix-get-time-string (seconds)
+ "Return formatted time string from SECONDS.
+Use `guix-time-format'."
+ (format-time-string guix-time-format (seconds-to-time seconds)))
+
+(defun guix-get-one-line (str)
+ "Return one-line string from a multi-line STR."
+ (replace-regexp-in-string "\n" " " str))
+
+(defun guix-format-insert (val &optional face format)
+ "Convert VAL into a string and insert it at point.
+If FACE is non-nil, propertize VAL with FACE.
+If FORMAT is non-nil, format VAL with FORMAT."
+ (let ((str (guix-get-string val face)))
+ (insert (if format
+ (format format str)
+ str))))
+
+(defun guix-mapinsert (function sequence separator)
+ "Like `mapconcat' but for inserting text.
+Apply FUNCTION to each element of SEQUENCE, and insert SEPARATOR
+at point between each FUNCTION call."
+ (when sequence
+ (funcall function (car sequence))
+ (mapc (lambda (obj)
+ (insert separator)
+ (funcall function obj))
+ (cdr sequence))))
+
+(defun guix-insert-button (label face action &optional message
+ &rest properties)
+ "Make button with LABEL and insert it at point.
+Propertize button with FACE.
+ACTION is a function called when the button is pressed. It
+should accept button as the argument.
+MESSAGE is a button message.
+See `insert-text-button' for the meaning of PROPERTIES."
+ (if (null label)
+ (guix-format-insert nil)
+ (apply #'insert-text-button
+ label
+ 'face face
+ 'action action
+ 'follow-link t
+ 'help-echo message
+ properties)))
+
+(defun guix-split-insert (val &optional face col separator)
+ "Convert VAL into a string, split it and insert at point.
+
+If FACE is non-nil, propertize returned string with this FACE.
+
+If COL is non-nil and result string is a one-line string longer
+than COL, split it into several short lines.
+
+Separate inserted lines with SEPARATOR."
+ (if (null val)
+ (guix-format-insert nil)
+ (let ((strings (guix-split-string (guix-get-string val) col)))
+ (guix-mapinsert (lambda (str) (guix-format-insert str face))
+ strings
+ (or separator "")))))
+
+(defun guix-split-string (str &optional col)
+ "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,
+split it into several short lines."
+ (let ((strings (split-string str "\n *")))
+ (if (and col
+ (null (cdr strings)) ; if not multi-line
+ (> (length str) col))
+ (split-string (guix-get-filled-string str col) "\n")
+ strings)))
+
+(defun guix-get-filled-string (str col)
+ "Return string by filling STR to column COL."
+ (with-temp-buffer
+ (insert str)
+ (let ((fill-column col))
+ (fill-region (point-min) (point-max)))
+ (buffer-string)))
+
+(defun guix-completing-read-multiple (prompt table &optional predicate
+ require-match initial-input
+ hist def inherit-input-method)
+ "Same as `completing-read-multiple' but remove duplicates in result."
+ (cl-remove-duplicates
+ (completing-read-multiple prompt table predicate
+ require-match initial-input
+ hist def inherit-input-method)
+ :test #'string=))
+
+(defun guix-get-key-val (alist &rest keys)
+ "Return value from ALIST by KEYS.
+ALIST is alist of alists of alists ... which can be consecutively
+accessed with KEYS."
+ (let ((val alist))
+ (dolist (key keys val)
+ (setq val (cdr (assq key val))))))
+
+(provide 'guix-utils)
+
+;;; guix-utils.el ends here
--- /dev/null
+;;; guix.el --- Interface for GNU Guix package manager
+
+;; Copyright © 2014 Alex Kost <alezost@gmail.com>
+
+;; Package-Requires: ((geiser "0.3"))
+;; Keywords: tools
+
+;; This file is part of GNU Guix.
+
+;; GNU Guix is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Guix is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package provides an interface for searching, listing and getting
+;; information about Guix packages and generations; and for
+;; installing/upgrading/removing packages.
+
+;;; Code:
+
+(require 'guix-list)
+(require 'guix-info)
+
+(defgroup guix nil
+ "Interface for Guix package manager."
+ :prefix "guix-"
+ :group 'external)
+
+(defcustom guix-list-single-package nil
+ "If non-nil, list a package even if it is the only matching result.
+If nil, show a single package in the info buffer."
+ :type 'boolean
+ :group 'guix)
+
+(defcustom guix-show-generations-function 'guix-generation-list-get-show
+ "Default function used to display generations."
+ :type '(choice (function-item guix-generation-list-get-show)
+ (function-item guix-generation-info-get-show))
+ :group 'guix)
+
+(defvar guix-search-params '(name synopsis description)
+ "Default list of package parameters for searching by regexp.")
+
+(defvar guix-search-history nil
+ "A history of minibuffer prompts.")
+
+(defun guix-get-show-packages (search-type &rest search-vals)
+ "Search for packages and show results.
+
+See `guix-get-entries' for the meaning of SEARCH-TYPE and
+SEARCH-VALS.
+
+Results are displayed in the list buffer, unless a single package
+is found and `guix-list-single-package' is nil."
+ (let* ((list-params (guix-package-list-get-params-for-receiving))
+ (packages (guix-get-entries 'package search-type
+ search-vals list-params)))
+ (if (or guix-list-single-package
+ (cdr packages))
+ (guix-package-list-set packages search-type search-vals)
+ (let ((info-params (guix-package-info-get-params-for-receiving)))
+ (unless (equal list-params info-params)
+ ;; If we don't have required info, we should receive it again
+ (setq packages (guix-get-entries 'package search-type
+ search-vals info-params))))
+ (guix-package-info-set packages search-type search-vals))))
+
+(defun guix-get-show-generations (search-type &rest search-vals)
+ "Search for generations and show results."
+ (apply guix-show-generations-function search-type search-vals))
+
+;;;###autoload
+(defun guix-search-by-name (name)
+ "Search for Guix packages by NAME.
+NAME is a string with name specification. It may optionally contain
+a version number. Examples: \"guile\", \"guile-2.0.11\"."
+ (interactive
+ (list (read-string "Package name: " nil 'guix-search-history)))
+ (guix-get-show-packages 'name name))
+
+;;;###autoload
+(defun guix-search-by-regexp (regexp &rest params)
+ "Search for Guix packages by REGEXP.
+PARAMS are package parameters that should be searched.
+If PARAMS are not specified, use `guix-search-params'."
+ (interactive
+ (list (read-string "Regexp: " nil 'guix-search-history)))
+ (or params (setq params guix-search-params))
+ (guix-get-show-packages 'regexp regexp params))
+
+;;;###autoload
+(defun guix-installed-packages ()
+ "Display information about installed Guix packages."
+ (interactive)
+ (guix-get-show-packages 'installed))
+
+;;;###autoload
+(defun guix-obsolete-packages ()
+ "Display information about obsolete Guix packages."
+ (interactive)
+ (guix-get-show-packages 'obsolete))
+
+;;;###autoload
+(defun guix-all-available-packages ()
+ "Display information about all available Guix packages."
+ (interactive)
+ (guix-get-show-packages 'all-available))
+
+;;;###autoload
+(defun guix-newest-available-packages ()
+ "Display information about the newest available Guix packages."
+ (interactive)
+ (guix-get-show-packages 'newest-available))
+
+;;;###autoload
+(defun guix-generations (&optional number)
+ "Display information about last NUMBER generations.
+If NUMBER is nil, display all generations.
+
+Generations can be displayed in a list or info buffers depending
+on `guix-show-generations-function'.
+
+Interactively, NUMBER is defined by a numeric prefix."
+ (interactive "P")
+ (if (numberp number)
+ (guix-get-show-generations 'last number)
+ (guix-get-show-generations 'all)))
+
+(provide 'guix)
+
+;;; guix.el ends here
HCoop / jackhill / guix / guix.git / commitdiff