Browse Source

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.
gn-latest-20200428
Alex Kost 6 years ago
parent
commit
457f60fa06
16 changed files with 3507 additions and 0 deletions
  1. +5
    -0
      .gitignore
  2. +4
    -0
      Makefile.am
  3. +7
    -0
      configure.ac
  4. +321
    -0
      doc/emacs.texi
  5. +3
    -0
      doc/guix.texi
  6. +43
    -0
      emacs.am
  7. +301
    -0
      emacs/guix-backend.el
  8. +607
    -0
      emacs/guix-base.el
  9. +64
    -0
      emacs/guix-helper.scm.in
  10. +92
    -0
      emacs/guix-history.el
  11. +556
    -0
      emacs/guix-info.el
  12. +14
    -0
      emacs/guix-init.el.in
  13. +586
    -0
      emacs/guix-list.el
  14. +603
    -0
      emacs/guix-main.scm
  15. +160
    -0
      emacs/guix-utils.el
  16. +141
    -0
      emacs/guix.el

+ 5
- 0
.gitignore View File

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

+ 4
- 0
Makefile.am View File

@@ -277,6 +277,10 @@ AM_DISTCHECK_CONFIGURE_FLAGS = \
--with-nix-prefix="$(NIX_PREFIX)" \
--enable-daemon

dist_emacsui_DATA = emacs/guix-main.scm
nodist_emacsui_DATA = emacs/guix-helper.scm
include emacs.am

dist-hook: sync-descriptions gen-ChangeLog assert-no-store-file-names
distcheck-hook: assert-binaries-available assert-final-inputs-self-contained



+ 7
- 0
configure.ac 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([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

+ 321
- 0
doc/emacs.texi 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

+ 3
- 0
doc/guix.texi View File

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

@include emacs.texi

@node Substitutes
@section Substitutes



+ 43
- 0
emacs.am 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
- 0
emacs/guix-backend.el 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
- 0
emacs/guix-base.el 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
- 0
emacs/guix-helper.scm.in 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
- 0
emacs/guix-history.el 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
- 0
emacs/guix-info.el 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
- 0
emacs/guix-init.el.in 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
- 0
emacs/guix-list.el 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.