Add Emacs user interface.

* 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.
This commit is contained in:
Alex Kost 2014-08-27 16:44:17 +04:00
parent a423555d3c
commit 457f60fa06
16 changed files with 3507 additions and 0 deletions

5
.gitignore vendored
View file

@ -105,3 +105,8 @@ GTAGS
/nix-setuid-helper /nix-setuid-helper
/nix/scripts/guix-authenticate /nix/scripts/guix-authenticate
/nix/scripts/offload /nix/scripts/offload
/emacs/Makefile.in
/emacs/Makefile
/emacs/guix-autoloads.el
/emacs/guix-helper.scm
/emacs/guix-init.el

View file

@ -277,6 +277,10 @@ AM_DISTCHECK_CONFIGURE_FLAGS = \
--with-nix-prefix="$(NIX_PREFIX)" \ --with-nix-prefix="$(NIX_PREFIX)" \
--enable-daemon --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 dist-hook: sync-descriptions gen-ChangeLog assert-no-store-file-names
distcheck-hook: assert-binaries-available assert-final-inputs-self-contained distcheck-hook: assert-binaries-available assert-final-inputs-self-contained

View file

@ -174,4 +174,11 @@ AC_CONFIG_FILES([scripts/guix], [chmod +x scripts/guix])
AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env]) AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env])
AC_CONFIG_FILES([test-env], [chmod +x test-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 AC_OUTPUT

321
doc/emacs.texi Normal file
View file

@ -0,0 +1,321 @@
@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

View file

@ -581,6 +581,7 @@ management tools it provides.
@menu @menu
* Features:: How Guix will make your life brighter. * Features:: How Guix will make your life brighter.
* Invoking guix package:: Package installation, removal, etc. * Invoking guix package:: Package installation, removal, etc.
* Emacs Interface:: Package management from Emacs.
* Substitutes:: Downloading pre-built binaries. * Substitutes:: Downloading pre-built binaries.
* Packages with Multiple Outputs:: Single source package, multiple outputs. * Packages with Multiple Outputs:: Single source package, multiple outputs.
* Invoking guix gc:: Running the garbage collector. * Invoking guix gc:: Running the garbage collector.
@ -955,6 +956,8 @@ Finally, since @command{guix package} may actually start build
processes, it supports all the common build options that @command{guix processes, it supports all the common build options that @command{guix
build} supports (@pxref{Invoking guix build, common build options}). build} supports (@pxref{Invoking guix build, common build options}).
@include emacs.texi
@node Substitutes @node Substitutes
@section Substitutes @section Substitutes

43
emacs.am Normal file
View file

@ -0,0 +1,43 @@
# 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)\")))"

301
emacs/guix-backend.el Normal file
View file

@ -0,0 +1,301 @@
;;; 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.")
;;; 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)))
;;; 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

607
emacs/guix-base.el Normal file
View file

@ -0,0 +1,607 @@
;;; 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)
;;; 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)))
;;; 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))
;;; 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))))
;;; 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)
;;; 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)))
;;; 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)))
;;; 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

64
emacs/guix-helper.scm.in Normal file
View file

@ -0,0 +1,64 @@
;;; 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")

92
emacs/guix-history.el Normal file
View file

@ -0,0 +1,92 @@
;;; 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

556
emacs/guix-info.el Normal file
View file

@ -0,0 +1,556 @@
;;; 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))
(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.")
;;; 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"))
;;; 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))
;;; 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

14
emacs/guix-init.el.in Normal file
View file

@ -0,0 +1,14 @@
(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)

586
emacs/guix-list.el Normal file
View file

@ -0,0 +1,586 @@
;;; 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))
;;; 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))
(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)
;;; 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))))
;;; 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

603
emacs/guix-main.scm Normal file
View file

@ -0,0 +1,603 @@
;;; 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)))
'()))
;;; 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)))
;;; 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))
(_ '()))))
;;; 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)))))))))

160
emacs/guix-utils.el Normal file
View file

@ -0,0 +1,160 @@
;;; 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

141
emacs/guix.el Normal file
View file

@ -0,0 +1,141 @@
;;; 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