summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--.gitignore5
-rw-r--r--Makefile.am4
-rw-r--r--configure.ac7
-rw-r--r--doc/emacs.texi321
-rw-r--r--doc/guix.texi3
-rw-r--r--emacs.am43
-rw-r--r--emacs/guix-backend.el301
-rw-r--r--emacs/guix-base.el607
-rw-r--r--emacs/guix-helper.scm.in64
-rw-r--r--emacs/guix-history.el92
-rw-r--r--emacs/guix-info.el556
-rw-r--r--emacs/guix-init.el.in14
-rw-r--r--emacs/guix-list.el586
-rw-r--r--emacs/guix-main.scm603
-rw-r--r--emacs/guix-utils.el160
-rw-r--r--emacs/guix.el141
16 files changed, 3507 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore
index dacd234c9b3..a424a397c4e 100644
--- a/.gitignore
+++ b/.gitignore
@@ -105,3 +105,8 @@ GTAGS
105/nix-setuid-helper 105/nix-setuid-helper
106/nix/scripts/guix-authenticate 106/nix/scripts/guix-authenticate
107/nix/scripts/offload 107/nix/scripts/offload
108/emacs/Makefile.in
109/emacs/Makefile
110/emacs/guix-autoloads.el
111/emacs/guix-helper.scm
112/emacs/guix-init.el
diff --git a/Makefile.am b/Makefile.am
index d25eeeb76e7..156c560665c 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -277,6 +277,10 @@ AM_DISTCHECK_CONFIGURE_FLAGS = \
277 --with-nix-prefix="$(NIX_PREFIX)" \ 277 --with-nix-prefix="$(NIX_PREFIX)" \
278 --enable-daemon 278 --enable-daemon
279 279
280dist_emacsui_DATA = emacs/guix-main.scm
281nodist_emacsui_DATA = emacs/guix-helper.scm
282include emacs.am
283
280dist-hook: sync-descriptions gen-ChangeLog assert-no-store-file-names 284dist-hook: sync-descriptions gen-ChangeLog assert-no-store-file-names
281distcheck-hook: assert-binaries-available assert-final-inputs-self-contained 285distcheck-hook: assert-binaries-available assert-final-inputs-self-contained
282 286
diff --git a/configure.ac b/configure.ac
index 71b3ddacaa3..698dd857847 100644
--- a/configure.ac
+++ b/configure.ac
@@ -174,4 +174,11 @@ AC_CONFIG_FILES([scripts/guix], [chmod +x scripts/guix])
174AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env]) 174AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env])
175AC_CONFIG_FILES([test-env], [chmod +x test-env]) 175AC_CONFIG_FILES([test-env], [chmod +x test-env])
176 176
177dnl Emacs interface.
178AM_PATH_LISPDIR
179emacsuidir="${guilemoduledir}/guix/emacs"
180AC_SUBST([emacsuidir])
181AC_CONFIG_FILES([emacs/guix-init.el
182 emacs/guix-helper.scm])
183
177AC_OUTPUT 184AC_OUTPUT
diff --git a/doc/emacs.texi b/doc/emacs.texi
new file mode 100644
index 00000000000..55feb1bf9fd
--- /dev/null
+++ b/doc/emacs.texi
@@ -0,0 +1,321 @@
1@node Emacs Interface
2@section Emacs Interface
3
4@cindex emacs
5GNU Guix comes with a visual user interface for GNU@tie{}Emacs, known
6as ``guix.el''. It can be used for routine package management tasks,
7pretty much like the @command{guix package} command (@pxref{Invoking
8guix package}). Specifically, ``guix.el'' makes it easy to:
9
10@itemize
11@item browse and display packages and generations;
12@item search, install, upgrade and remove packages;
13@item display packages from previous generations;
14@item do some other useful things.
15@end itemize
16
17@menu
18* Initial Setup: emacs Initial Setup. Preparing @file{~/.emacs}.
19* Usage: emacs Usage. Using the interface.
20* Configuration: emacs Configuration. Configuring the interface.
21@end menu
22
23@node emacs Initial Setup
24@subsection Initial Setup
25
26To be able to use ``guix.el'', you need to install the following
27packages:
28
29@itemize
30@item
31@uref{http://www.gnu.org/software/emacs/, GNU Emacs}, version 24.3 or
32later;
33
34@item
35@uref{http://nongnu.org/geiser/, Geiser}, version 0.3 or later: it is
36used for interacting with the Guile process.
37
38@end itemize
39
40When it is done, add the following into your init file (@pxref{Init
41File,,, emacs, The Emacs Editor}):
42
43@example
44(require 'guix-init nil t)
45@end example
46
47However there is a chance that @code{load-path} of your Emacs does not
48contain a directory with ``guix.el'' (usually it is
49@file{/usr/share/emacs/site-lisp/}). In that case you need to add it
50before requiring (@pxref{Lisp Libraries,,, emacs, The Emacs Editor}):
51
52@example
53(add-to-list 'load-path "/path/to/directory-with-guix.el")
54(require 'guix-init)
55@end example
56
57Do not worry about the efficiency of that @code{require} thing. It will
58not load the whole ``guix.el'' package, it will just autoload the main
59interactive commands (@pxref{Autoload,,, elisp, Emacs Lisp}).
60
61
62@node emacs Usage
63@subsection Usage
64
65Once ``guix.el'' has been successfully configured, you should be able to
66use commands for displaying packages and generations. This information
67can be displayed in a ``list'' or ``info'' buffer.
68
69@menu
70* Commands: emacs Commands. @kbd{M-x guix-@dots{}}
71* General information: emacs General info. Common for both interfaces.
72* ``List'' buffer: emacs List buffer. List-like interface.
73* ``Info'' buffer: emacs Info buffer. Help-like interface.
74@end menu
75
76@node emacs Commands
77@subsubsection Commands
78
79You may use the following commands to display packages and generations:
80
81@table @kbd
82@item M-x guix-all-available-packages
83@itemx M-x guix-newest-available-packages
84Display all/newest available packages.
85
86@item M-x guix-installed-packages
87Display all packages installed in the current profile.
88
89@item M-x guix-obsolete-packages
90Display obsolete packages (the packages that are installed in the
91current profile but cannot be found among available packages).
92
93@item M-x guix-search-by-name
94Display package(s) with the specified name.
95
96@item M-x guix-search-by-regexp
97Search for packages by a specified regexp. By default ``name'',
98``synopsis'' and ``description'' of the packages will be searched. This
99can be changed by modifying @code{guix-search-params} variable.
100
101@item M-x guix-generations
102List generations for the current profile. With numeric prefix, show so
103many last generations.
104
105@end table
106
107It is possible to change the currently used profile with
108@kbd{M-x@tie{}guix-set-current-profile}. This has the same effect as
109specifying @code{--profile} option for @command{guix package}
110(@pxref{Invoking guix package}).
111
112@node emacs General info
113@subsubsection General information
114
115The following keys are available for both ``list'' and ``info'' types of
116buffers:
117
118@table @kbd
119@item l
120@itemx r
121Go backward/forward by the history of the displayed results (this
122history is similar to the history of the Emacs @code{help-mode} or
123@code{Info-mode}).
124
125@item g
126Revert current buffer: update information about the displayed
127packages/generations and redisplay it.
128
129@item R
130Redisplay current buffer (without updating information).
131
132@item C-c C-z
133Go to the Guix REPL (@pxref{The REPL,,, geiser, Geiser User Manual}).
134
135@item h
136@itemx ?
137Describe current mode to see all available bindings.
138
139@end table
140
141@emph{Hint:} If you need several ``list'' or ``info'' buffers, you can
142simlpy @kbd{M-x clone-buffer} them, and each buffer will have its own
143history.
144
145@emph{Warning:} Name/version pairs cannot be used to identify packages
146(because a name is not necessarily unique), so ``guix.el'' uses special
147identifiers that live only during a guile session, so if the Guix REPL
148was restarted, you may want to revert ``list'' buffer (by pressing
149@kbd{g}).
150
151@node emacs List buffer
152@subsubsection ``List'' buffer
153
154An interface of a ``list'' buffer is similar to the interface provided
155by ``package.el'' (@pxref{Package Menu,,, emacs, The Emacs Editor}).
156
157Default key bindings available for both ``package-list'' and
158``generation-list'' buffers:
159
160@table @kbd
161@item m
162Mark the current entry.
163@item M
164Mark all entries.
165@item u
166Unmark the current entry.
167@item @key{DEL}
168Unmark backward.
169@item U
170Unmark all entries.
171@item S
172Sort entries by a specified column.
173@end table
174
175A ``package-list'' buffer additionally provides the following bindings:
176
177@table @kbd
178@item @key{RET}
179Describe marked packages (display available information in a
180``package-info'' buffer).
181@item i
182Mark a package for installation (with prefix, prompt for output(s) to
183install).
184@item d
185Mark a package for deletion.
186@item ^
187Mark a package for upgrading.
188@item x
189Execute actions on marked packages.
190@end table
191
192A ``generation-list'' buffer additionally provides the following
193bindings:
194
195@table @kbd
196@item @key{RET}
197List packages installed in the current generation.
198@item i
199Describe marked generations (display available information in a
200``generation-info'' buffer).
201@end table
202
203@node emacs Info buffer
204@subsubsection ``Info'' buffer
205
206The interface of an ``info'' buffer is similar to the interface of
207@code{help-mode} (@pxref{Help Mode,,, emacs, The Emacs Editor}).
208
209``Info'' buffer contains some buttons (as usual you may use @key{TAB} /
210@kbd{S-@key{TAB}} to move between buttons---@pxref{Mouse References,,,
211emacs, The Emacs Editor}) which can be used to:
212
213@itemize @bullet
214@item (in a ``package-info'' buffer)
215
216@itemize @minus
217@item install/remove a package;
218@item jump to a package location;
219@item browse home page of a package;
220@item describe packages from ``Inputs'' fields.
221@end itemize
222
223@item (in a ``generation-info'' buffer)
224
225@itemize @minus
226@item remove a generation;
227@item list packages installed in a generation;
228@item jump to a generation directory.
229@end itemize
230
231@end itemize
232
233
234@node emacs Configuration
235@subsection Configuration
236
237There are many variables you can modify to change the appearance or
238behavior of Emacs user interface. Some of these variables are described
239in this section. Also you can use Custom Interface (@pxref{Easy
240Customization,,, emacs, The Emacs Editor}) to explore/set variables (not
241all) and faces.
242
243@menu
244* Guile and Build Options: emacs Build Options. Specifying how packages are built.
245* Keymaps: emacs Keymaps. Configuring key bindings.
246* Appearance: emacs Appearance. Settings for visual appearance.
247@end menu
248
249@node emacs Build Options
250@subsubsection Guile and Build Options
251
252@table @code
253@item guix-guile-program
254If you have some special needs for starting a Guile process, you may set
255this variable, for example:
256
257@example
258(setq guix-guile-program '("/bin/guile" "--no-auto-compile"))
259@end example
260
261@item guix-use-substitutes
262Has the same meaning as @code{--no-substitutes} option (@pxref{Invoking
263guix build}).
264
265@item guix-dry-run
266Has the same meaning as @code{--dry-run} option (@pxref{Invoking guix
267build}).
268
269@end table
270
271@node emacs Keymaps
272@subsubsection Keymaps
273
274If you want to change default key bindings, use the following keymaps
275(@pxref{Init Rebinding,,, emacs, The Emacs Editor}):
276
277@table @code
278@item guix-list-mode-map
279Parent keymap with general keys for ``list'' buffers.
280
281@item guix-package-list-mode-map
282Keymap with specific keys for ``package-list'' buffers.
283
284@item guix-generation-list-mode-map
285Keymap with specific keys for ``generation-list'' buffers.
286
287@item guix-info-mode-map
288Parent keymap with general keys for ``info'' buffers.
289
290@item guix-package-info-mode-map
291Keymap with specific keys for ``package-info'' buffers.
292
293@item guix-generation-info-mode-map
294Keymap with specific keys for ``generation-info'' buffers.
295
296@end table
297
298@node emacs Appearance
299@subsubsection Appearance
300
301You can change almost any aspect of ``list'' / ``info'' buffers using
302the following variables:
303
304@table @code
305@item guix-list-column-format
306@itemx guix-list-column-titles
307@itemx guix-list-column-value-methods
308Specify the columns, their names, what and how is displayed in ``list''
309buffers.
310
311@item guix-info-displayed-params
312@itemx guix-info-insert-methods
313@itemx guix-info-ignore-empty-vals
314@itemx guix-info-param-title-format
315@itemx guix-info-multiline-prefix
316@itemx guix-info-indent
317@itemx guix-info-fill-column
318@itemx guix-info-delimiter
319Various settings for ``info'' buffers.
320
321@end table
diff --git a/doc/guix.texi b/doc/guix.texi
index 384e2a9ced1..1f192bf0a7a 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -581,6 +581,7 @@ management tools it provides.
581@menu 581@menu
582* Features:: How Guix will make your life brighter. 582* Features:: How Guix will make your life brighter.
583* Invoking guix package:: Package installation, removal, etc. 583* Invoking guix package:: Package installation, removal, etc.
584* Emacs Interface:: Package management from Emacs.
584* Substitutes:: Downloading pre-built binaries. 585* Substitutes:: Downloading pre-built binaries.
585* Packages with Multiple Outputs:: Single source package, multiple outputs. 586* Packages with Multiple Outputs:: Single source package, multiple outputs.
586* Invoking guix gc:: Running the garbage collector. 587* Invoking guix gc:: Running the garbage collector.
@@ -955,6 +956,8 @@ Finally, since @command{guix package} may actually start build
955processes, it supports all the common build options that @command{guix 956processes, it supports all the common build options that @command{guix
956build} supports (@pxref{Invoking guix build, common build options}). 957build} supports (@pxref{Invoking guix build, common build options}).
957 958
959@include emacs.texi
960
958@node Substitutes 961@node Substitutes
959@section Substitutes 962@section Substitutes
960 963
diff --git a/emacs.am b/emacs.am
new file mode 100644
index 00000000000..86ae3a2c9f2
--- /dev/null
+++ b/emacs.am
@@ -0,0 +1,43 @@
1# GNU Guix --- Functional package management for GNU
2# Copyright © 2014 Alex Kost <alezost@gmail.com>
3#
4# This file is part of GNU Guix.
5#
6# GNU Guix is free software; you can redistribute it and/or modify it
7# under the terms of the GNU General Public License as published by
8# the Free Software Foundation; either version 3 of the License, or (at
9# your option) any later version.
10#
11# GNU Guix is distributed in the hope that it will be useful, but
12# WITHOUT ANY WARRANTY; without even the implied warranty of
13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14# GNU General Public License for more details.
15#
16# You should have received a copy of the GNU General Public License
17# along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
18
19AUTOLOADS = emacs/guix-autoloads.el
20
21ELFILES = \
22 emacs/guix-backend.el \
23 emacs/guix-base.el \
24 emacs/guix-history.el \
25 emacs/guix-info.el \
26 emacs/guix-list.el \
27 emacs/guix-utils.el \
28 emacs/guix.el
29
30dist_lisp_DATA = \
31 $(ELFILES) \
32 $(AUTOLOADS)
33
34nodist_lisp_DATA = \
35 emacs/guix-init.el
36
37$(AUTOLOADS): $(ELFILES)
38 $(EMACS) --batch --eval \
39 "(let ((backup-inhibited t) \
40 (generated-autoload-file \
41 (expand-file-name \"$(AUTOLOADS)\" \"$(srcdir)\"))) \
42 (update-directory-autoloads \
43 (expand-file-name \"emacs\" \"$(srcdir)\")))"
diff --git a/emacs/guix-backend.el b/emacs/guix-backend.el
new file mode 100644
index 00000000000..46d0f067781
--- /dev/null
+++ b/emacs/guix-backend.el
@@ -0,0 +1,301 @@
1;;; guix-backend.el --- Communication with Geiser
2
3;; Copyright © 2014 Alex Kost <alezost@gmail.com>
4
5;; This file is part of GNU Guix.
6
7;; GNU Guix is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation, either version 3 of the License, or
10;; (at your option) any later version.
11
12;; GNU Guix is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with this program. If not, see <http://www.gnu.org/licenses/>.
19
20;;; Commentary:
21
22;; This file provides the code for interacting with Guile using Geiser.
23
24;; By default (if `guix-use-guile-server' is non-nil) 2 Geiser REPLs are
25;; started. The main one (with "guile --listen" process) is used for
26;; "interacting" with a user - for showing a progress of
27;; installing/deleting Guix packages. The second (internal) REPL is
28;; used for synchronous evaluating, e.g. when information about
29;; packages/generations should be received for a list/info buffer.
30;;
31;; This "2 REPLs concept" makes it possible to have a running process of
32;; installing/deleting packages and to continue to search/list/get info
33;; about other packages at the same time. If you prefer to use a single
34;; Guix REPL, do not try to receive any information while there is a
35;; running code in the REPL (see
36;; <https://github.com/jaor/geiser/issues/28>).
37;;
38;; If you need to use "guix.el" in another Emacs (i.e. when there is
39;; a runnig "guile --listen..." REPL somewhere), you can either change
40;; `guix-default-port' in that Emacs instance or set
41;; `guix-use-guile-server' to t.
42;;
43;; Guix REPLs (unlike the usual Geiser REPLs) are not added to
44;; `geiser-repl--repls' variable, and thus cannot be used for evaluating
45;; while editing scm-files. The only purpose of Guix REPLs is to be an
46;; intermediate between "Guix/Guile level" and "Emacs interface level".
47;; That being said you can still want to use a Guix REPL while hacking
48;; auxiliary scheme-files for "guix.el". You can just use "M-x
49;; connect-to-guile" (connect to "localhost" and `guix-default-port') to
50;; have a usual Geiser REPL with all stuff defined by "guix.el" package.
51
52;;; Code:
53
54(require 'geiser-mode)
55
56(defvar guix-load-path
57 (file-name-directory (or load-file-name
58 (locate-library "guix")))
59 "Directory with scheme files for \"guix.el\" package.")
60
61(defvar guix-helper-file
62 (expand-file-name "guix-helper.scm" guix-load-path)
63 "Auxiliary scheme file for loading.")
64
65(defvar guix-guile-program (or geiser-guile-binary "guile")
66 "Name of the guile executable used for Guix REPL.
67May be either a string (the name of the executable) or a list of
68strings of the form:
69
70 (NAME . ARGS)
71
72Where ARGS is a list of arguments to the guile program.")
73
74
75;;; REPL
76
77(defgroup guix-repl nil
78 "Settings for Guix REPLs."
79 :prefix "guix-repl-"
80 :group 'guix)
81
82(defcustom guix-repl-startup-time 30000
83 "Time, in milliseconds, to wait for Guix REPL to startup.
84Same as `geiser-repl-startup-time' but is used for Guix REPL.
85If you have a slow system, try to increase this time."
86 :type 'integer
87 :group 'guix-repl)
88
89(defcustom guix-repl-buffer-name "*Guix REPL*"
90 "Default name of a Geiser REPL buffer used for Guix."
91 :type 'string
92 :group 'guix-repl)
93
94(defcustom guix-after-start-repl-hook ()
95 "Hook called after Guix REPL is started."
96 :type 'hook
97 :group 'guix-repl)
98
99(defcustom guix-use-guile-server t
100 "If non-nil, start guile with '--listen' argument.
101This allows to receive information about packages using an additional
102REPL while some packages are being installed/removed in the main REPL."
103 :type 'boolean
104 :group 'guix-repl)
105
106(defcustom guix-default-port 37246
107 "Default port used if `guix-use-guile-server' is non-nil."
108 :type 'integer
109 :group 'guix-repl)
110
111(defvar guix-repl-buffer nil
112 "Main Geiser REPL buffer used for communicating with Guix.
113This REPL is used for processing package actions and for
114receiving information if `guix-use-guile-server' is nil.")
115
116(defvar guix-internal-repl-buffer nil
117 "Additional Geiser REPL buffer used for communicating with Guix.
118This REPL is used for receiving information only if
119`guix-use-guile-server' is non-nil.")
120
121(defvar guix-internal-repl-buffer-name "*Guix Internal REPL*"
122 "Default name of an internal Guix REPL buffer.")
123
124(defun guix-get-guile-program (&optional internal)
125 "Return a value suitable for `geiser-guile-binary'."
126 (if (or internal
127 (not guix-use-guile-server))
128 guix-guile-program
129 (append (if (listp guix-guile-program)
130 guix-guile-program
131 (list guix-guile-program))
132 ;; Guile understands "--listen=..." but not "--listen ..."
133 (list (concat "--listen="
134 (number-to-string guix-default-port))))))
135
136(defun guix-start-process-maybe ()
137 "Start Geiser REPL configured for Guix if needed."
138 (guix-start-repl-maybe)
139 (if guix-use-guile-server
140 (guix-start-repl-maybe 'internal)
141 (setq guix-internal-repl-buffer guix-repl-buffer)))
142
143(defun guix-start-repl-maybe (&optional internal)
144 "Start Guix REPL if needed.
145If INTERNAL is non-nil, start an internal REPL."
146 (let* ((repl-var (guix-get-repl-buffer-variable internal))
147 (repl (symbol-value repl-var)))
148 (unless (and (buffer-live-p repl)
149 (get-buffer-process repl))
150 ;; Kill REPL buffer with a dead process
151 (and (buffer-live-p repl) (kill-buffer repl))
152 (or internal
153 (message "Starting Geiser REPL for Guix ..."))
154 (let ((geiser-guile-binary (guix-get-guile-program internal))
155 (geiser-guile-init-file (or internal guix-helper-file))
156 (repl (get-buffer-create
157 (guix-get-repl-buffer-name internal))))
158 (condition-case err
159 (guix-start-repl repl
160 (and internal
161 (geiser-repl--read-address
162 "localhost" guix-default-port)))
163 (text-read-only
164 (error (concat "Couldn't start Guix REPL. Perhaps the port %s is busy.\n"
165 "See buffer '%s' for details")
166 guix-default-port (buffer-name repl))))
167 (set repl-var repl)
168 (unless internal
169 (message "Guix REPL has been started.")
170 (run-hooks 'guix-after-start-repl-hook))))))
171
172(defun guix-start-repl (buffer &optional address)
173 "Start Guix REPL in BUFFER.
174If ADDRESS is non-nil, connect to a remote guile process using
175this address (it should be defined by
176`geiser-repl--read-address')."
177 ;; A mix of the code from `geiser-repl--start-repl' and
178 ;; `geiser-repl--to-repl-buffer'.
179 (let ((impl 'guile)
180 (geiser-guile-load-path (list guix-load-path))
181 (geiser-repl-startup-time guix-repl-startup-time))
182 (with-current-buffer buffer
183 (geiser-repl-mode)
184 (geiser-impl--set-buffer-implementation impl)
185 (geiser-repl--autodoc-mode -1)
186 (goto-char (point-max))
187 (let* ((prompt-re (geiser-repl--prompt-regexp impl))
188 (deb-prompt-re (geiser-repl--debugger-prompt-regexp impl))
189 (prompt (geiser-con--combined-prompt prompt-re deb-prompt-re)))
190 (or prompt-re
191 (error "Oh no! Guix REPL in the buffer '%s' has not been started"
192 (buffer-name buffer)))
193 (geiser-repl--save-remote-data address)
194 (geiser-repl--start-scheme impl address prompt)
195 (geiser-repl--quit-setup)
196 (geiser-repl--history-setup)
197 (setq-local geiser-repl--repls (list buffer))
198 (geiser-repl--set-this-buffer-repl buffer)
199 (setq geiser-repl--connection
200 (geiser-con--make-connection
201 (get-buffer-process (current-buffer))
202 prompt-re
203 deb-prompt-re))
204 (geiser-repl--startup impl address)
205 (geiser-repl--autodoc-mode 1)
206 (geiser-company--setup geiser-repl-company-p)
207 (add-hook 'comint-output-filter-functions
208 'geiser-repl--output-filter
209 nil t)
210 (set-process-query-on-exit-flag
211 (get-buffer-process (current-buffer))
212 geiser-repl-query-on-kill-p)))))
213
214(defun guix-get-repl-buffer (&optional internal)
215 "Return Guix REPL buffer; start REPL if needed.
216If INTERNAL is non-nil, return an additional internal REPL."
217 (guix-start-process-maybe)
218 (let ((repl (symbol-value (guix-get-repl-buffer-variable internal))))
219 ;; If a new Geiser REPL is started, `geiser-repl--repl' variable may
220 ;; be set to the new value in a Guix REPL, so set it back to a
221 ;; proper value here.
222 (with-current-buffer repl
223 (geiser-repl--set-this-buffer-repl repl))
224 repl))
225
226(defun guix-get-repl-buffer-variable (&optional internal)
227 "Return the name of a variable with a REPL buffer."
228 (if internal
229 'guix-internal-repl-buffer
230 'guix-repl-buffer))
231
232(defun guix-get-repl-buffer-name (&optional internal)
233 "Return the name of a REPL buffer."
234 (if internal
235 guix-internal-repl-buffer-name
236 guix-repl-buffer-name))
237
238(defun guix-switch-to-repl (&optional internal)
239 "Switch to Guix REPL.
240If INTERNAL is non-nil (interactively with prefix), switch to the
241additional internal REPL if it exists."
242 (interactive "P")
243 (geiser-repl--switch-to-buffer (guix-get-repl-buffer internal)))
244
245
246;;; Evaluating expressions
247
248(defun guix-make-guile-expression (fun &rest args)
249 "Return string containing a guile expression for calling FUN with ARGS."
250 (format "(%S %s)" fun
251 (mapconcat
252 (lambda (arg)
253 (cond
254 ((null arg) "'()")
255 ((or (eq arg t)
256 ;; An ugly hack to separate 'false' from nil
257 (equal arg 'f)
258 (keywordp arg))
259 (concat "#" (prin1-to-string arg t)))
260 ((or (symbolp arg) (listp arg))
261 (concat "'" (prin1-to-string arg)))
262 (t (prin1-to-string arg))))
263 args
264 " ")))
265
266(defun guix-eval (str &optional wrap)
267 "Evaluate guile expression STR.
268If WRAP is non-nil, wrap STR into (begin ...) form.
269Return a list of strings with result values of evaluation."
270 (with-current-buffer (guix-get-repl-buffer 'internal)
271 (let* ((wrapped (if wrap (geiser-debug--wrap-region str) str))
272 (code `(:eval (:scm ,wrapped)))
273 (ret (geiser-eval--send/wait code)))
274 (if (geiser-eval--retort-error ret)
275 (error "Error in evaluating guile expression: %s"
276 (geiser-eval--retort-output ret))
277 (cdr (assq 'result ret))))))
278
279(defun guix-eval-read (str &optional wrap)
280 "Evaluate guile expression STR.
281For the meaning of WRAP, see `guix-eval'.
282Return elisp expression of the first result value of evaluation."
283 ;; Parsing scheme code with elisp `read' is probably not the best idea.
284 (read (replace-regexp-in-string
285 "#f\\|#<unspecified>" "nil"
286 (replace-regexp-in-string
287 "#t" "t" (car (guix-eval str wrap))))))
288
289(defun guix-eval-in-repl (str)
290 "Switch to Guix REPL and evaluate STR with guile expression there."
291 (let ((repl (guix-get-repl-buffer)))
292 (with-current-buffer repl
293 (delete-region (geiser-repl--last-prompt-end) (point-max))
294 (goto-char (point-max))
295 (insert str)
296 (geiser-repl--send-input))
297 (geiser-repl--switch-to-buffer repl)))
298
299(provide 'guix-backend)
300
301;;; guix-backend.el ends here
diff --git a/emacs/guix-base.el b/emacs/guix-base.el
new file mode 100644
index 00000000000..563df496cd6
--- /dev/null
+++ b/emacs/guix-base.el
@@ -0,0 +1,607 @@
1;;; guix-base.el --- Common definitions
2
3;; Copyright © 2014 Alex Kost <alezost@gmail.com>
4
5;; This file is part of GNU Guix.
6
7;; GNU Guix is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation, either version 3 of the License, or
10;; (at your option) any later version.
11
12;; GNU Guix is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with this program. If not, see <http://www.gnu.org/licenses/>.
19
20;;; Commentary:
21
22;; This file provides some base and common definitions for guix.el
23;; package.
24
25;; List and info buffers have many common patterns that are defined
26;; using `guix-define-buffer-type' macro from this file.
27
28;;; Code:
29
30(require 'cl-lib)
31(require 'guix-backend)
32(require 'guix-utils)
33
34
35;;; Profiles
36
37(defvar guix-user-profile
38 (expand-file-name "~/.guix-profile")
39 "User profile.")
40
41(defvar guix-default-profile
42 (concat (or (getenv "NIX_STATE_DIR") "/var/guix")
43 "/profiles/per-user/"
44 (getenv "USER")
45 "/guix-profile")
46 "Default Guix profile.")
47
48(defvar guix-current-profile guix-default-profile
49 "Current profile.")
50
51(defun guix-set-current-profile (path)
52 "Set `guix-current-profile' to PATH.
53Interactively, prompt for PATH. With prefix, use
54`guix-default-profile'."
55 (interactive
56 (list (if current-prefix-arg
57 guix-default-profile
58 (read-file-name "Set profile: "
59 (file-name-directory guix-current-profile)))))
60 (let ((path (directory-file-name (expand-file-name path))))
61 (setq guix-current-profile
62 (if (string= path guix-user-profile)
63 guix-default-profile
64 path))
65 (message "Current profile has been set to '%s'."
66 guix-current-profile)))
67
68
69;;; Parameters of the entries
70
71(defvar guix-param-titles
72 '((package
73 (id . "ID")
74 (name . "Name")
75 (version . "Version")
76 (license . "License")
77 (synopsis . "Synopsis")
78 (description . "Description")
79 (home-url . "Home page")
80 (outputs . "Outputs")
81 (inputs . "Inputs")
82 (native-inputs . "Native inputs")
83 (propagated-inputs . "Propagated inputs")
84 (location . "Location")
85 (installed . "Installed"))
86 (installed
87 (path . "Installed path")
88 (dependencies . "Dependencies")
89 (output . "Output"))
90 (generation
91 (id . "ID")
92 (number . "Number")
93 (prev-number . "Previous number")
94 (path . "Path")
95 (time . "Time")))
96 "List for defining titles of entry parameters.
97Titles are used for displaying information about entries.
98Each element of the list has a form:
99
100 (ENTRY-TYPE . ((PARAM . TITLE) ...))")
101
102(defun guix-get-param-title (entry-type param)
103 "Return title of an ENTRY-TYPE entry parameter PARAM."
104 (or (guix-get-key-val guix-param-titles
105 entry-type param)
106 (prog1 (symbol-name param)
107 (message "Couldn't find title for '%S %S'."
108 entry-type param))))
109
110(defun guix-get-name-spec (name version &optional output)
111 "Return Guix package specification by its NAME, VERSION and OUTPUT."
112 (concat name "-" version
113 (when output (concat ":" output))))
114
115(defun guix-get-full-name (entry &optional output)
116 "Return name specification of the package ENTRY and OUTPUT."
117 (guix-get-name-spec (guix-get-key-val entry 'name)
118 (guix-get-key-val entry 'version)
119 output))
120
121(defun guix-get-installed-outputs (entry)
122 "Return list of installed outputs for the package ENTRY."
123 (mapcar (lambda (installed-entry)
124 (guix-get-key-val installed-entry 'output))
125 (guix-get-key-val entry 'installed)))
126
127(defun guix-get-entry-by-id (id entries)
128 "Return entry from ENTRIES by entry ID."
129 (cl-find-if (lambda (entry)
130 (equal id (guix-get-key-val entry 'id)))
131 entries))
132
133
134;;; Location of the packages
135
136(defvar guix-directory nil
137 "Default Guix directory.
138If it is not set by a user, it is set after starting Guile REPL.
139This directory is used to define location of the packages.")
140
141(defun guix-set-directory ()
142 "Set `guix-directory' if needed."
143 (or guix-directory
144 (setq guix-directory
145 (guix-eval-read "%guix-dir"))))
146
147(add-hook 'guix-after-start-repl-hook 'guix-set-directory)
148
149(defun guix-find-location (location)
150 "Go to LOCATION of a package.
151LOCATION is a string of the form:
152
153 \"PATH:LINE:COLUMN\"
154
155If PATH is relative, it is considered to be relative to
156`guix-directory'."
157 (cl-multiple-value-bind (path line col)
158 (split-string location ":")
159 (let ((file (expand-file-name path guix-directory))
160 (line (string-to-number line))
161 (col (string-to-number col)))
162 (find-file file)
163 (goto-char (point-min))
164 (forward-line (- line 1))
165 (move-to-column col)
166 (recenter 1))))
167
168
169;;; Common definitions for buffer types
170
171(defvar-local guix-entries nil
172 "List of the currently displayed entries.
173Each element of the list is alist with entry info of the
174following form:
175
176 ((PARAM . VAL) ...)
177
178PARAM is a name of the entry parameter.
179VAL is a value of this parameter.")
180(put 'guix-entries 'permanent-local t)
181
182(defvar-local guix-search-type nil
183 "Type of the current search.")
184(put 'guix-search-type 'permanent-local t)
185
186(defvar-local guix-search-vals nil
187 "Values of the current search.")
188(put 'guix-search-vals 'permanent-local t)
189
190(defsubst guix-set-vars (entries search-type search-vals)
191 (setq guix-entries entries
192 guix-search-type search-type
193 guix-search-vals search-vals))
194
195(defmacro guix-define-buffer-type (buf-type entry-type &rest args)
196 "Define common stuff for BUF-TYPE buffers for displaying entries.
197
198ENTRY-TYPE is a type of displayed entries (see
199`guix-get-entries').
200
201In the text below TYPE means ENTRY-TYPE-BUF-TYPE.
202
203This macro defines `guix-TYPE-mode', a custom group, several user
204variables and the following functions:
205
206 - `guix-TYPE-get-params-for-receiving'
207 - `guix-TYPE-revert'
208 - `guix-TYPE-redisplay'
209 - `guix-TYPE-make-history-item'
210 - `guix-TYPE-set'
211 - `guix-TYPE-show'
212 - `guix-TYPE-get-show'
213
214The following stuff should be defined outside this macro:
215
216 - `guix-BUF-TYPE-mode' - parent mode for the defined mode.
217
218 - `guix-BUF-TYPE-insert-entries' - function for inserting
219 entries in the current buffer; it is called with 2 arguments:
220 entries of the form of `guix-entries' and ENTRY-TYPE.
221
222 - `guix-BUF-TYPE-get-displayed-params' - function returning a
223 list of parameters displayed in the current buffer; it is
224 called with ENTRY-TYPE as argument.
225
226 - `guix-TYPE-mode-initialize' (optional) - function for
227 additional mode settings; it is called without arguments.
228
229Remaining argument (ARGS) should have a form [KEYWORD VALUE] ... The
230following keywords are available:
231
232 - `:required' - default value for the defined
233 `guix-TYPE-required-params' variable.
234
235 - `:history-size' - default value for the defined
236 `guix-TYPE-history-size' variable.
237
238 - `:revert' - default value for the defined
239 `guix-TYPE-revert-no-confirm' variable."
240 (let* ((entry-type-str (symbol-name entry-type))
241 (buf-type-str (symbol-name buf-type))
242 (Entry-type-str (capitalize entry-type-str))
243 (Buf-type-str (capitalize buf-type-str))
244 (entry-str (concat entry-type-str " entries"))
245 (buf-str (concat buf-type-str " buffer"))
246 (prefix (concat "guix-" entry-type-str "-" buf-type-str))
247 (group (intern prefix))
248 (mode-map-str (concat prefix "-mode-map"))
249 (mode-map (intern mode-map-str))
250 (parent-mode (intern (concat "guix-" buf-type-str "-mode")))
251 (mode (intern (concat prefix "-mode")))
252 (mode-init-fun (intern (concat prefix "-mode-initialize")))
253 (buf-name-var (intern (concat prefix "-buffer-name")))
254 (revert-var (intern (concat prefix "-revert-no-confirm")))
255 (revert-fun (intern (concat prefix "-revert")))
256 (redisplay-fun (intern (concat prefix "-redisplay")))
257 (history-var (intern (concat prefix "-history-size")))
258 (history-fun (intern (concat prefix "-make-history-item")))
259 (params-var (intern (concat prefix "-required-params")))
260 (params-fun (intern (concat prefix "-get-params-for-receiving")))
261 (set-fun (intern (concat prefix "-set")))
262 (show-fun (intern (concat prefix "-show")))
263 (get-show-fun (intern (concat prefix "-get-show")))
264 (revert-val nil)
265 (history-val 20)
266 (params-val '(id)))
267
268 ;; Process the keyword args.
269 (while (keywordp (car args))
270 (pcase (pop args)
271 (`:required (setq params-val (pop args)))
272 (`:history-size (setq history-val (pop args)))
273 (`:revert (setq revert-val (pop args)))
274 (_ (pop args))))
275
276 `(progn
277 (defgroup ,group nil
278 ,(concat Buf-type-str " buffer with " entry-str ".")
279 :prefix ,(concat prefix "-")
280 :group ',(intern (concat "guix-" buf-type-str)))
281
282 (defcustom ,buf-name-var ,(format "*Guix %s %s*"
283 Entry-type-str Buf-type-str)
284 ,(concat "Default name of the " buf-str " for displaying " entry-str ".")
285 :type 'string
286 :group ',group)
287
288 (defcustom ,history-var ,history-val
289 ,(concat "Maximum number of items saved in the history of the " buf-str ".\n"
290 "If 0, the history is disabled.")
291 :type 'integer
292 :group ',group)
293
294 (defcustom ,revert-var ,revert-val
295 ,(concat "If non-nil, do not ask to confirm for reverting the " buf-str ".")
296 :type 'boolean
297 :group ',group)
298
299 (defvar ,params-var ',params-val
300 ,(concat "List of required " entry-type-str " parameters.\n\n"
301 "Displayed parameters and parameters from this list are received\n"
302 "for each " entry-type-str ".\n\n"
303 "May be a special value `all', in which case all supported\n"
304 "parameters are received (this may be very slow for a big number\n"
305 "of entries).\n\n"
306 "Do not remove `id' from this list as it is required for\n"
307 "identifying an entry."))
308
309 (define-derived-mode ,mode ,parent-mode ,(concat "Guix-" Buf-type-str)
310 ,(concat "Major mode for displaying information about " entry-str ".\n\n"
311 "\\{" mode-map-str "}")
312 (setq-local revert-buffer-function ',revert-fun)
313 (setq-local guix-history-size ,history-var)
314 (and (fboundp ',mode-init-fun) (,mode-init-fun)))
315
316 (let ((map ,mode-map))
317 (define-key map (kbd "l") 'guix-history-back)
318 (define-key map (kbd "r") 'guix-history-forward)
319 (define-key map (kbd "g") 'revert-buffer)
320 (define-key map (kbd "R") ',redisplay-fun)
321 (define-key map (kbd "C-c C-z") 'guix-switch-to-repl))
322
323 (defun ,params-fun ()
324 ,(concat "Return " entry-type-str " parameters that should be received.")
325 (unless (equal ,params-var 'all)
326 (cl-union ,params-var
327 (,(intern (concat "guix-" buf-type-str "-get-displayed-params"))
328 ',entry-type))))
329
330 (defun ,revert-fun (_ignore-auto noconfirm)
331 "Update information in the current buffer.
332The function is suitable for `revert-buffer-function'.
333See `revert-buffer' for the meaning of NOCONFIRM."
334 (when (or ,revert-var
335 noconfirm
336 (y-or-n-p "Update current information? "))
337 (let ((entries (guix-get-entries ',entry-type guix-search-type
338 guix-search-vals (,params-fun))))
339 (,set-fun entries guix-search-type guix-search-vals t))))
340
341 (defun ,redisplay-fun ()
342 "Redisplay current information.
343This function will not update the information, use
344\"\\[revert-buffer]\" if you want the full update."
345 (interactive)
346 (,show-fun guix-entries)
347 (guix-result-message guix-entries ',entry-type
348 guix-search-type guix-search-vals))
349
350 (defun ,history-fun ()
351 "Make and return a history item for the current buffer."
352 (list (lambda (entries search-type search-vals)
353 (,show-fun entries)
354 (guix-set-vars entries search-type search-vals)
355 (guix-result-message entries ',entry-type
356 search-type search-vals))
357 guix-entries guix-search-type guix-search-vals))
358
359 (defun ,set-fun (entries search-type search-vals &optional history-replace)
360 ,(concat "Set up the " buf-str " for displaying " entry-str ".\n\n"
361 "Display ENTRIES, set variables and make history item.\n\n"
362 "ENTRIES should have a form of `guix-entries'.\n\n"
363 "See `guix-get-entries' for the meaning of SEARCH-TYPE and\n"
364 "SEARCH-VALS.\n\n"
365 "If HISTORY-REPLACE is non-nil, replace current history item,\n"
366 "otherwise add the new one.")
367 (when entries
368 (let ((buf (if (eq major-mode ',mode)
369 (current-buffer)
370 (get-buffer-create ,buf-name-var))))
371 (with-current-buffer buf
372 (,show-fun entries)
373 (guix-set-vars entries search-type search-vals)
374 (funcall (if history-replace
375 #'guix-history-replace
376 #'guix-history-add)
377 (,history-fun)))
378 (pop-to-buffer buf
379 '((display-buffer-reuse-window
380 display-buffer-same-window)))))
381 (guix-result-message entries ',entry-type
382 search-type search-vals))
383
384 (defun ,show-fun (entries)
385 ,(concat "Display " entry-type-str " ENTRIES in the current " buf-str ".")
386 (let ((inhibit-read-only t))
387 (erase-buffer)
388 (,mode)
389 (,(intern (concat "guix-" buf-type-str "-insert-entries"))
390 entries ',entry-type)
391 (goto-char (point-min))))
392
393 (defun ,get-show-fun (search-type &rest search-vals)
394 ,(concat "Search for " entry-str " and show results in the " buf-str ".\n"
395 "See `guix-get-entries' for the meaning of SEARCH-TYPE and\n"
396 "SEARCH-VALS.")
397 (let ((entries (guix-get-entries ',entry-type search-type
398 search-vals (,params-fun))))
399 (,set-fun entries search-type search-vals))))))
400
401(put 'guix-define-buffer-type 'lisp-indent-function 'defun)
402
403
404;;; Messages
405
406(defvar guix-messages
407 '((package
408 (id
409 (0 "Packages not found.")
410 (1 "")
411 (many "%d packages." count))
412 (name
413 (0 "The package '%s' not found." val)
414 (1 "A single package with name '%s'." val)
415 (many "%d packages with '%s' name." count val))
416 (regexp
417 (0 "No packages matching '%s'." val)
418 (1 "A single package matching '%s'." val)
419 (many "%d packages matching '%s'." count val))
420 (all-available
421 (0 "No packages are available for some reason.")
422 (1 "A single available package (that's strange).")
423 (many "%d available packages." count))
424 (newest-available
425 (0 "No packages are available for some reason.")
426 (1 "A single newest available package (that's strange).")
427 (many "%d newest available packages." count))
428 (installed
429 (0 "No installed packages.")
430 (1 "A single installed package.")
431 (many "%d installed packages." count))
432 (obsolete
433 (0 "No obsolete packages.")
434 (1 "A single obsolete package.")
435 (many "%d obsolete packages." count))
436 (generation
437 (0 "No packages installed in generation %d." val)
438 (1 "A single package installed in generation %d." val)
439 (many "%d packages installed in generation %d." count val)))
440 (generation
441 (id
442 (0 "Generations not found.")
443 (1 "")
444 (many "%d generations." count))
445 (last
446 (0 "No available generations.")
447 (1 "The last generation.")
448 (many "%d last generations." count))
449 (all
450 (0 "No available generations.")
451 (1 "A single available generation.")
452 (many "%d available generations." count)))))
453
454(defun guix-result-message (entries entry-type search-type search-vals)
455 "Display an appropriate message after displaying ENTRIES."
456 (let* ((val (car search-vals))
457 (count (length entries))
458 (count-key (if (> count 1) 'many count))
459 (msg-spec (guix-get-key-val guix-messages
460 entry-type search-type count-key))
461 (format (car msg-spec))
462 (args (cdr msg-spec)))
463 (mapc (lambda (subst)
464 (setq args (cl-substitute (car subst) (cdr subst) args)))
465 (list (cons count 'count)
466 (cons val 'val)))
467 (apply #'message format args)))
468
469
470;;; Getting info about packages and generations
471
472(defun guix-get-entries (entry-type search-type search-vals &optional params)
473 "Search for entries of ENTRY-TYPE.
474
475Call an appropriate scheme function and return a list of the
476form of `guix-entries'.
477
478ENTRY-TYPE should be one of the following symbols: `package' or
479`generation'.
480
481SEARCH-TYPE may be one of the following symbols:
482
483- If ENTRY-TYPE is `package': `id', `name', `regexp',
484 `all-available', `newest-available', `installed', `obsolete',
485 `generation'.
486
487- If ENTRY-TYPE is `generation': `id', `last', `all'.
488
489PARAMS is a list of parameters for receiving. If nil, get
490information with all available parameters."
491 (guix-eval-read (guix-make-guile-expression
492 'get-entries
493 guix-current-profile params
494 entry-type search-type search-vals)))
495
496
497;;; Actions on packages and generations
498
499(defcustom guix-operation-confirm t
500 "If nil, do not prompt to confirm an operation."
501 :type 'boolean
502 :group 'guix)
503
504(defcustom guix-use-substitutes t
505 "If non-nil, use substitutes for the Guix packages."
506 :type 'boolean
507 :group 'guix)
508
509(defvar guix-dry-run nil
510 "If non-nil, do not perform the real actions, just simulate.")
511
512(defvar guix-temp-buffer-name " *Guix temp*"
513 "Name of a buffer used for displaying info before executing operation.")
514
515(defun guix-process-package-actions (&rest actions)
516 "Process package ACTIONS.
517Each action is a list of the form:
518
519 (ACTION-TYPE PACKAGE-SPEC ...)
520
521ACTION-TYPE is one of the following symbols: `install',
522`upgrade', `remove'/`delete'.
523PACKAGE-SPEC should have the following form: (ID [OUTPUT] ...)."
524 (let (install upgrade remove)
525 (mapc (lambda (action)
526 (let ((action-type (car action))
527 (specs (cdr action)))
528 (cl-case action-type
529 (install (setq install (append install specs)))
530 (upgrade (setq upgrade (append upgrade specs)))
531 ((remove delete) (setq remove (append remove specs))))))
532 actions)
533 (when (guix-continue-package-operation-p
534 :install install :upgrade upgrade :remove remove)
535 (guix-eval-in-repl
536 (guix-make-guile-expression
537 'process-package-actions guix-current-profile
538 :install install :upgrade upgrade :remove remove
539 :use-substitutes? (or guix-use-substitutes 'f)
540 :dry-run? (or guix-dry-run 'f))))))
541
542(cl-defun guix-continue-package-operation-p (&key install upgrade remove)
543 "Return non-nil if a package operation should be continued.
544Ask a user if needed (see `guix-operation-confirm').
545INSTALL, UPGRADE, REMOVE are 'package action specifications'.
546See `guix-process-package-actions' for details."
547 (or (null guix-operation-confirm)
548 (let* ((entries (guix-get-entries
549 'package 'id
550 (list (append (mapcar #'car install)
551 (mapcar #'car upgrade)
552 (mapcar #'car remove)))
553 '(id name version location)))
554 (install-strings (guix-get-package-strings install entries))
555 (upgrade-strings (guix-get-package-strings upgrade entries))
556 (remove-strings (guix-get-package-strings remove entries)))
557 (if (or install-strings upgrade-strings remove-strings)
558 (let ((buf (get-buffer-create guix-temp-buffer-name)))
559 (with-current-buffer buf
560 (setq-local cursor-type nil)
561 (setq buffer-read-only nil)
562 (erase-buffer)
563 (guix-insert-package-strings install-strings "install")
564 (guix-insert-package-strings upgrade-strings "upgrade")
565 (guix-insert-package-strings remove-strings "remove")
566 (let ((win (temp-buffer-window-show
567 buf
568 '((display-buffer-reuse-window
569 display-buffer-at-bottom)
570 (window-height . fit-window-to-buffer)))))
571 (prog1 (y-or-n-p "Continue operation? ")
572 (quit-window nil win)))))
573 (message "Nothing to be done. If the REPL was restarted, information is not up-to-date.")
574 nil))))
575
576(defun guix-get-package-strings (specs entries)
577 "Return short package descriptions for performing package actions.
578See `guix-process-package-actions' for the meaning of SPECS.
579ENTRIES is a list of package entries to get info about packages."
580 (delq nil
581 (mapcar
582 (lambda (spec)
583 (let* ((id (car spec))
584 (outputs (cdr spec))
585 (entry (guix-get-entry-by-id id entries)))
586 (when entry
587 (let ((location (guix-get-key-val entry 'location)))
588 (concat (guix-get-full-name entry)
589 (when outputs
590 (concat ":"
591 (mapconcat #'identity outputs ",")))
592 (when location
593 (concat "\t(" location ")")))))))
594 specs)))
595
596(defun guix-insert-package-strings (strings action)
597 "Insert information STRINGS at point for performing package ACTION."
598 (when strings
599 (insert "Package(s) to " (guix-get-string action 'bold) ":\n")
600 (mapc (lambda (str)
601 (insert " " str "\n"))
602 strings)
603 (insert "\n")))
604
605(provide 'guix-base)
606
607;;; guix-base.el ends here
diff --git a/emacs/guix-helper.scm.in b/emacs/guix-helper.scm.in
new file mode 100644
index 00000000000..554d55119f1
--- /dev/null
+++ b/emacs/guix-helper.scm.in
@@ -0,0 +1,64 @@
1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
3;;;
4;;; This file is part of GNU Guix.
5;;;
6;;; GNU Guix is free software; you can redistribute it and/or modify it
7;;; under the terms of the GNU General Public License as published by
8;;; the Free Software Foundation; either version 3 of the License, or (at
9;;; your option) any later version.
10;;;
11;;; GNU Guix is distributed in the hope that it will be useful, but
12;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
18
19;;; Commentary:
20
21;; This is an auxiliary file for the Emacs UI. It is used to add Guix
22;; directories to path variables and to load the main code.
23
24;;; Code:
25
26(use-modules (ice-9 regex)
27 (srfi srfi-26))
28
29(define %guix-dir)
30
31;; The code is taken from ‘guix’ executable script
32(define (set-paths!)
33 (define-syntax-rule (push! elt v) (set! v (cons elt v)))
34
35 (define config-lookup
36 (let ((config '(("prefix" . "@prefix@")
37 ("guilemoduledir" . "@guilemoduledir@")))
38 (var-ref-regexp (make-regexp "\\$\\{([a-z]+)\\}")))
39 (define (expand-var-ref match)
40 (lookup (match:substring match 1)))
41 (define (expand str)
42 (regexp-substitute/global #f var-ref-regexp str
43 'pre expand-var-ref 'post))
44 (define (lookup name)
45 (expand (assoc-ref config name)))
46 lookup))
47
48 (let ((module-dir (config-lookup "guilemoduledir"))
49 (updates-dir (and=> (or (getenv "XDG_CONFIG_HOME")
50 (and=> (getenv "HOME")
51 (cut string-append <> "/.config")))
52 (cut string-append <> "/guix/latest"))))
53 (push! module-dir %load-compiled-path)
54 (if (and updates-dir (file-exists? updates-dir))
55 (begin
56 (set! %guix-dir updates-dir)
57 (push! updates-dir %load-path)
58 (push! updates-dir %load-compiled-path))
59 (set! %guix-dir module-dir))))
60
61(set-paths!)
62
63(load-from-path "guix-main")
64
diff --git a/emacs/guix-history.el b/emacs/guix-history.el
new file mode 100644
index 00000000000..5d301a689e8
--- /dev/null
+++ b/emacs/guix-history.el
@@ -0,0 +1,92 @@
1;;; guix-history.el --- History of buffer information
2
3;; Copyright © 2014 Alex Kost <alezost@gmail.com>
4
5;; This file is part of GNU Guix.
6
7;; GNU Guix is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation, either version 3 of the License, or
10;; (at your option) any later version.
11
12;; GNU Guix is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with this program. If not, see <http://www.gnu.org/licenses/>.
19
20;;; Commentary:
21
22;; This file provides support for history of buffers similar to the
23;; history of a `help-mode' buffer.
24
25;;; Code:
26
27(require 'cl-macs)
28
29(defvar-local guix-history-stack-item nil
30 "Current item of the history.
31A list of the form (FUNCTION [ARGS ...]).
32The item is used by calling (apply FUNCTION ARGS).")
33(put 'guix-history-stack-item 'permanent-local t)
34
35(defvar-local guix-history-back-stack nil
36 "Stack (list) of visited items.
37Each element of the list has a form of `guix-history-stack-item'.")
38(put 'guix-history-back-stack 'permanent-local t)
39
40(defvar-local guix-history-forward-stack nil
41 "Stack (list) of items visited with `guix-history-back'.
42Each element of the list has a form of `guix-history-stack-item'.")
43(put 'guix-history-forward-stack 'permanent-local t)
44
45(defvar guix-history-size 0
46 "Maximum number of items saved in history.
47If 0, the history is disabled.")
48
49(defun guix-history-add (item)
50 "Add ITEM to history."
51 (and guix-history-stack-item
52 (push guix-history-stack-item guix-history-back-stack))
53 (setq guix-history-forward-stack nil
54 guix-history-stack-item item)
55 (when (>= (length guix-history-back-stack)
56 guix-history-size)
57 (setq guix-history-back-stack
58 (cl-loop for elt in guix-history-back-stack
59 for i from 1 to guix-history-size
60 collect elt))))
61
62(defun guix-history-replace (item)
63 "Replace current item in history with ITEM."
64 (setq guix-history-stack-item item))
65
66(defun guix-history-goto (item)
67 "Go to the ITEM of history.
68ITEM should have the form of `guix-history-stack-item'."
69 (or (listp item)
70 (error "Wrong value of history element"))
71 (setq guix-history-stack-item item)
72 (apply (car item) (cdr item)))
73
74(defun guix-history-back ()
75 "Go back to the previous element of history in the current buffer."
76 (interactive)
77 (or guix-history-back-stack
78 (user-error "No previous element in history"))
79 (push guix-history-stack-item guix-history-forward-stack)
80 (guix-history-goto (pop guix-history-back-stack)))
81
82(defun guix-history-forward ()
83 "Go forward to the next element of history in the current buffer."
84 (interactive)
85 (or guix-history-forward-stack
86 (user-error "No next element in history"))
87 (push guix-history-stack-item guix-history-back-stack)
88 (guix-history-goto (pop guix-history-forward-stack)))
89
90(provide 'guix-history)
91
92;;; guix-history.el ends here
diff --git a/emacs/guix-info.el b/emacs/guix-info.el
new file mode 100644
index 00000000000..687a15eefa5
--- /dev/null
+++ b/emacs/guix-info.el
@@ -0,0 +1,556 @@
1;;; guix-info.el --- Info buffers for displaying entries
2
3;; Copyright © 2014 Alex Kost <alezost@gmail.com>
4
5;; This file is part of GNU Guix.
6
7;; GNU Guix is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation, either version 3 of the License, or
10;; (at your option) any later version.
11
12;; GNU Guix is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with this program. If not, see <http://www.gnu.org/licenses/>.
19
20;;; Commentary:
21
22;; This file provides a help-like buffer for displaying information
23;; about Guix packages and generations.
24
25;;; Code:
26
27(require 'guix-history)
28(require 'guix-base)
29(require 'guix-utils)
30
31(defgroup guix-info nil
32 "General settings for info buffers."
33 :prefix "guix-info-"
34 :group 'guix)
35
36(defface guix-info-param-title
37 '((t :inherit font-lock-type-face))
38 "Face used for titles of parameters."
39 :group 'guix-info)
40
41(defface guix-info-file-path
42 '((t :inherit link))
43 "Face used for file paths."
44 :group 'guix-info)
45
46(defface guix-info-url
47 '((t :inherit link))
48 "Face used for URLs."
49 :group 'guix-info)
50
51(defface guix-info-time
52 '((t :inherit font-lock-constant-face))
53 "Face used for timestamps."
54 :group 'guix-info)
55
56(defface guix-info-action-button
57 '((((type x w32 ns) (class color))
58 :box (:line-width 2 :style released-button)
59 :background "lightgrey" :foreground "black")
60 (t :inherit button))
61 "Face used for action buttons."
62 :group 'guix-info)
63
64(defface guix-info-action-button-mouse
65 '((((type x w32 ns) (class color))
66 :box (:line-width 2 :style released-button)
67 :background "grey90" :foreground "black")
68 (t :inherit highlight))
69 "Mouse face used for action buttons."
70 :group 'guix-info)
71
72(defcustom guix-info-ignore-empty-vals nil
73 "If non-nil, do not display parameters with nil values."
74 :type 'boolean
75 :group 'guix-info)
76
77(defvar guix-info-param-title-format "%-18s: "
78 "String used to format a title of a parameter.
79It should be a '%s'-sequence. After inserting a title formatted
80with this string, a value of the parameter is inserted.
81This string is used by `guix-info-insert-title-default'.")
82
83(defvar guix-info-multiline-prefix (make-string 20 ?\s)
84 "String used to format multi-line parameter values.
85If a value occupies more than one line, this string is inserted
86in the beginning of each line after the first one.
87This string is used by `guix-info-insert-val-default'.")
88
89(defvar guix-info-indent 2
90 "Number of spaces used to indent various parts of inserted text.")
91
92(defvar guix-info-fill-column 60
93 "Column used for filling (word wrapping) parameters with long lines.
94If a value is not multi-line and it occupies more than this
95number of characters, it will be split into several lines.")
96
97(defvar guix-info-delimiter "\n\f\n"
98 "String used to separate entries.")
99
100(defvar guix-info-insert-methods
101 '((package
102 (name guix-package-info-name)
103 (version guix-package-info-version)
104 (license guix-package-info-license)
105 (synopsis guix-package-info-synopsis)
106 (description guix-package-info-insert-description
107 guix-info-insert-title-simple)
108 (outputs guix-package-info-insert-outputs
109 guix-info-insert-title-simple)
110 (home-url guix-info-insert-url)
111 (inputs guix-package-info-insert-inputs)
112 (native-inputs guix-package-info-insert-native-inputs)
113 (propagated-inputs guix-package-info-insert-propagated-inputs)
114 (location guix-package-info-insert-location))
115 (installed
116 (path guix-package-info-insert-output-path
117 guix-info-insert-title-simple)
118 (dependencies guix-package-info-insert-output-dependencies
119 guix-info-insert-title-simple))
120 (generation
121 (number guix-generation-info-insert-number)
122 (path guix-info-insert-file-path)
123 (time guix-info-insert-time)))
124 "Methods for inserting parameter values.
125Each element of the list should have a form:
126
127 (ENTRY-TYPE . ((PARAM INSERT-VALUE [INSERT-TITLE]) ...))
128
129INSERT-VALUE may be either nil, a face name or a function. If it
130is nil or a face, `guix-info-insert-val-default' function is
131called with parameter value and INSERT-VALUE as arguments. If it
132is a function, this function is called with parameter value and
133entry info (alist of parameters and their values) as arguments.
134
135INSERT-TITLE may be either nil, a face name or a function. If it
136is nil or a face, `guix-info-insert-title-default' function is
137called with parameter title and INSERT-TITLE as arguments. If it
138is a function, this function is called with parameter title as
139argument.")
140
141(defvar guix-info-displayed-params
142 '((package name version synopsis outputs location home-url
143 license inputs native-inputs propagated-inputs description)
144 (installed path dependencies)
145 (generation number prev-number time path))
146 "List of displayed entry parameters.
147Each element of the list should have a form:
148
149 (ENTRY-TYPE . (PARAM ...))
150
151The order of displayed parameters is the same as in this list.")
152
153(defun guix-info-get-insert-methods (entry-type param)
154 "Return list of insert methods for parameter PARAM of ENTRY-TYPE.
155See `guix-info-insert-methods' for details."
156 (guix-get-key-val guix-info-insert-methods
157 entry-type param))
158
159(defun guix-info-get-displayed-params (entry-type)
160 "Return parameters of ENTRY-TYPE that should be displayed."
161 (guix-get-key-val guix-info-displayed-params
162 entry-type))
163
164(defun guix-info-get-indent (&optional level)
165 "Return `guix-info-indent' \"multiplied\" by LEVEL spaces.
166LEVEL is 1 by default."
167 (make-string (* guix-info-indent (or level 1)) ?\s))
168
169(defun guix-info-insert-indent (&optional level)
170 "Insert `guix-info-indent' spaces LEVEL times (1 by default)."
171 (insert (guix-info-get-indent level)))
172
173(defun guix-info-insert-entries (entries entry-type)
174 "Display ENTRIES of ENTRY-TYPE in the current info buffer.
175ENTRIES should have a form of `guix-entries'."
176 (guix-mapinsert (lambda (entry)
177 (guix-info-insert-entry entry entry-type))
178 entries
179 guix-info-delimiter))
180
181(defun guix-info-insert-entry (entry entry-type &optional indent-level)
182 "Insert ENTRY of ENTRY-TYPE into the current info buffer.
183If INDENT-LEVEL is non-nil, indent displayed information by this
184number of `guix-info-indent' spaces."
185 (let ((region-beg (point)))
186 (mapc (lambda (param)
187 (guix-info-insert-param param entry entry-type))
188 (guix-info-get-displayed-params entry-type))
189 (when indent-level
190 (indent-rigidly region-beg (point)
191 (* indent-level guix-info-indent)))))
192
193(defun guix-info-insert-param (param entry entry-type)
194 "Insert title and value of a PARAM at point.
195ENTRY is alist with parameters and their values.
196ENTRY-TYPE is a type of ENTRY."
197 (let ((val (guix-get-key-val entry param)))
198 (unless (and guix-info-ignore-empty-vals (null val))
199 (let* ((title (guix-get-param-title entry-type param))
200 (insert-methods (guix-info-get-insert-methods entry-type param))
201 (val-method (car insert-methods))
202 (title-method (cadr insert-methods)))
203 (guix-info-method-funcall title title-method
204 #'guix-info-insert-title-default)
205 (guix-info-method-funcall val val-method
206 #'guix-info-insert-val-default
207 entry)
208 (insert "\n")))))
209
210(defun guix-info-method-funcall (val method default-fun &rest args)
211 "Call METHOD or DEFAULT-FUN.
212
213If METHOD is a function and VAL is non-nil, call this
214function by applying it to VAL and ARGS.
215
216If METHOD is a face, propertize inserted VAL with this face."
217 (cond ((or (null method)
218 (facep method))
219 (funcall default-fun val method))
220 ((functionp method)
221 (apply method val args))
222 (t (error "Unknown method '%S'" method))))
223
224(defun guix-info-insert-title-default (title &optional face format)
225 "Insert TITLE formatted with `guix-info-param-title-format' at point."
226 (guix-format-insert title
227 (or face 'guix-info-param-title)
228 (or format guix-info-param-title-format)))
229
230(defun guix-info-insert-title-simple (title &optional face)
231 "Insert TITLE at point."
232 (guix-info-insert-title-default title face "%s:"))
233
234(defun guix-info-insert-val-default (val &optional face)
235 "Format and insert parameter value VAL at point.
236
237This function is intended to be called after
238`guix-info-insert-title-default'.
239
240If VAL is a one-line string longer than `guix-info-fill-column',
241split it into several short lines. See also
242`guix-info-multiline-prefix'.
243
244If FACE is non-nil, propertize inserted line(s) with this FACE."
245 (guix-split-insert val face
246 guix-info-fill-column
247 (concat "\n" guix-info-multiline-prefix)))
248
249(defun guix-info-insert-val-simple (val &optional face-or-fun)
250 "Format and insert parameter value VAL at point.
251
252This function is intended to be called after
253`guix-info-insert-title-simple'.
254
255If VAL is a one-line string longer than `guix-info-fill-column',
256split it into several short lines and indent each line with
257`guix-info-indent' spaces.
258
259If FACE-OR-FUN is a face, propertize inserted line(s) with this FACE.
260
261If FACE-OR-FUN is a function, call it with VAL as argument. If
262VAL is a list, call the function on each element of this list."
263 (if (null val)
264 (progn (guix-info-insert-indent)
265 (guix-format-insert nil))
266 (let ((prefix (concat "\n" (guix-info-get-indent))))
267 (insert prefix)
268 (if (functionp face-or-fun)
269 (guix-mapinsert face-or-fun
270 (if (listp val) val (list val))
271 prefix)
272 (guix-split-insert val face-or-fun
273 guix-info-fill-column prefix)))))
274
275(defun guix-info-insert-action-button (label action &optional message
276 &rest properties)
277 "Make action button with LABEL and insert it at point.
278For the meaning of ACTION, MESSAGE and PROPERTIES, see
279`guix-insert-button'."
280 (apply #'guix-insert-button
281 label 'guix-info-action-button action message
282 'mouse-face 'guix-info-action-button-mouse
283 properties))
284
285(defun guix-info-insert-file-path (path &optional _)
286 "Make button from file PATH and insert it at point."
287 (guix-insert-button
288 path 'guix-info-file-path
289 (lambda (btn) (find-file (button-label btn)))
290 "Find file"))
291
292(defun guix-info-insert-url (url &optional _)
293 "Make button from URL and insert it at point."
294 (guix-insert-button
295 url 'guix-info-url
296 (lambda (btn) (browse-url (button-label btn)))
297 "Browse URL"))
298
299(defun guix-info-insert-time (seconds &optional _)
300 "Insert formatted time string using SECONDS at point."
301 (guix-info-insert-val-default (guix-get-time-string seconds)
302 'guix-info-time))
303
304
305(defvar guix-info-mode-map
306 (let ((map (make-sparse-keymap)))
307 (set-keymap-parent
308 map (make-composed-keymap button-buffer-map
309 special-mode-map))
310 map)
311 "Parent keymap for info buffers.")
312
313(define-derived-mode guix-info-mode special-mode "Guix-Info"
314 "Parent mode for displaying information in info buffers.")
315
316
317;;; Displaying packages
318
319(guix-define-buffer-type info package
320 :required (id installed non-unique))
321
322(defface guix-package-info-name
323 '((t :inherit font-lock-keyword-face))
324 "Face used for a name of a package."
325 :group 'guix-package-info)
326
327(defface guix-package-info-version
328 '((t :inherit font-lock-builtin-face))
329 "Face used for a version of a package."
330 :group 'guix-package-info)
331
332(defface guix-package-info-synopsis
333 '((t :inherit font-lock-doc-face))
334 "Face used for a synopsis of a package."
335 :group 'guix-package-info)
336
337(defface guix-package-info-description
338 '((t))
339 "Face used for a description of a package."
340 :group 'guix-package-info)
341
342(defface guix-package-info-license
343 '((t :inherit font-lock-string-face))
344 "Face used for a license of a package."
345 :group 'guix-package-info)
346
347(defface guix-package-info-location
348 '((t :inherit link))
349 "Face used for a location of a package."
350 :group 'guix-package-info)
351
352(defface guix-package-info-installed-outputs
353 '((default :weight bold)
354 (((class color) (min-colors 88) (background light))
355 :foreground "ForestGreen")
356 (((class color) (min-colors 88) (background dark))
357 :foreground "PaleGreen")
358 (((class color) (min-colors 8))
359 :foreground "green")
360 (t :underline t))
361 "Face used for installed outputs of a package."
362 :group 'guix-package-info)
363
364(defface guix-package-info-uninstalled-outputs
365 '((t :weight bold))
366 "Face used for uninstalled outputs of a package."
367 :group 'guix-package-info)
368
369(defface guix-package-info-obsolete
370 '((t :inherit error))
371 "Face used if a package is obsolete."
372 :group 'guix-package-info)
373
374(defun guix-package-info-insert-description (desc &optional _)
375 "Insert description DESC at point."
376 (guix-info-insert-val-simple desc 'guix-package-info-description))
377
378(defun guix-package-info-insert-location (location &optional _)
379 "Make button from file LOCATION and insert it at point."
380 (guix-insert-button
381 location 'guix-package-info-location
382 (lambda (btn) (guix-find-location (button-label btn)))
383 "Find location of this package"))
384
385(defmacro guix-package-info-define-insert-inputs (&optional type)
386 "Define a face and a function for inserting package inputs.
387TYPE is a type of inputs.
388Function name is `guix-package-info-insert-TYPE-inputs'.
389Face name is `guix-package-info-TYPE-inputs'."
390 (let* ((type-str (symbol-name type))
391 (type-name (and type (concat type-str "-")))
392 (type-desc (and type (concat type-str " ")))
393 (face (intern (concat "guix-package-info-" type-name "inputs")))
394 (fun (intern (concat "guix-package-info-insert-" type-name "inputs"))))
395 `(progn
396 (defface ,face
397 '((t :inherit button))
398 ,(concat "Face used for " type-desc "inputs of a package.")
399 :group 'guix-package-info)
400
401 (defun ,fun (inputs &optional _)
402 ,(concat "Make buttons from " type-desc "INPUTS and insert them at point.")
403 (guix-package-info-insert-full-names inputs ',face)))))
404
405(guix-package-info-define-insert-inputs)
406(guix-package-info-define-insert-inputs native)
407(guix-package-info-define-insert-inputs propagated)
408
409(defun guix-package-info-insert-full-names (names face)
410 "Make buttons from package NAMES and insert them at point.
411NAMES is a list of strings.
412Propertize buttons with FACE."
413 (if names
414 (guix-info-insert-val-default
415 (with-temp-buffer
416 (guix-mapinsert (lambda (name)
417 (guix-package-info-insert-full-name
418 name face))
419 names
420 guix-list-separator)
421 (buffer-substring (point-min) (point-max))))
422 (guix-format-insert nil)))
423
424(defun guix-package-info-insert-full-name (name face)
425 "Make button and insert package NAME at point.
426Propertize package button with FACE."
427 (guix-insert-button
428 name face
429 (lambda (btn)
430 (guix-package-info-get-show 'name (button-label btn)))
431 "Describe this package"))
432
433
434;;; Inserting outputs and installed parameters
435
436(defvar guix-package-info-output-format "%-10s"
437 "String used to format output names of the packages.
438It should be a '%s'-sequence. After inserting an output name
439formatted with this string, an action button is inserted.")
440
441(defvar guix-package-info-obsolete-string "(This package is obsolete)"
442 "String used if a package is obsolete.")
443
444(defun guix-package-info-insert-outputs (outputs entry)
445 "Insert OUTPUTS from package ENTRY at point."
446 (and (guix-get-key-val entry 'obsolete)
447 (guix-package-info-insert-obsolete-text))
448 (and (guix-get-key-val entry 'non-unique)
449 (guix-get-key-val entry 'installed)
450 (guix-package-info-insert-non-unique-text
451 (guix-get-full-name entry)))
452 (insert "\n")
453 (mapc (lambda (output)
454 (guix-package-info-insert-output output entry))
455 outputs))
456
457(defun guix-package-info-insert-obsolete-text ()
458 "Insert a message about obsolete package at point."
459 (guix-info-insert-indent)
460 (guix-format-insert guix-package-info-obsolete-string
461 'guix-package-info-obsolete))
462
463(defun guix-package-info-insert-non-unique-text (full-name)
464 "Insert a message about non-unique package with FULL-NAME at point."
465 (insert "\n")
466 (guix-info-insert-indent)
467 (insert "Installed outputs are displayed for a non-unique ")
468 (guix-package-info-insert-full-name full-name
469 'guix-package-info-inputs)
470 (insert " package."))
471
472(defun guix-package-info-insert-output (output entry)
473 "Insert OUTPUT at point.
474Make some fancy text with buttons and additional stuff if the
475current OUTPUT is installed (if there is such output in
476`installed' parameter of a package ENTRY)."
477 (let* ((installed (guix-get-key-val entry 'installed))
478 (obsolete (guix-get-key-val entry 'obsolete))
479 (installed-entry (cl-find-if
480 (lambda (entry)
481 (string= (guix-get-key-val entry 'output)
482 output))
483 installed))
484 (action-type (if installed-entry 'delete 'install)))
485 (guix-info-insert-indent)
486 (guix-format-insert output
487 (if installed-entry
488 'guix-package-info-installed-outputs
489 'guix-package-info-uninstalled-outputs)
490 guix-package-info-output-format)
491 (guix-package-info-insert-action-button action-type entry output)
492 (when obsolete
493 (guix-info-insert-indent)
494 (guix-package-info-insert-action-button 'upgrade entry output))
495 (insert "\n")
496 (when installed-entry
497 (guix-info-insert-entry installed-entry 'installed 2))))
498
499(defun guix-package-info-insert-action-button (type entry output)
500 "Insert button to process an action on a package OUTPUT at point.
501TYPE is one of the following symbols: `install', `delete', `upgrade'.
502ENTRY is an alist with package info."
503 (let ((type-str (capitalize (symbol-name type)))
504 (full-name (guix-get-full-name entry output)))
505 (guix-info-insert-action-button
506 type-str
507 (lambda (btn)
508 (guix-process-package-actions
509 (list (button-get btn 'action-type)
510 (list (button-get btn 'id)
511 (button-get btn 'output)))))
512 (concat type-str " '" full-name "'")
513 'action-type type
514 'id (guix-get-key-val entry 'id)
515 'output output)))
516
517(defun guix-package-info-insert-output-path (path &optional _)
518 "Insert PATH of the installed output."
519 (guix-info-insert-val-simple path #'guix-info-insert-file-path))
520
521(defun guix-package-info-insert-output-dependencies (deps &optional _)
522 "Insert dependencies DEPS of the installed output."
523 (guix-info-insert-val-simple deps #'guix-info-insert-file-path))
524
525
526;;; Displaying generations
527
528(guix-define-buffer-type info generation)
529
530(defface guix-generation-info-number
531 '((t :inherit font-lock-keyword-face))
532 "Face used for a number of a generation."
533 :group 'guix-generation-info)
534
535(declare-function guix-package-list-get-show "guix-list" t t)
536
537(defun guix-generation-info-insert-number (number &optional _)
538 "Insert generation NUMBER and action buttons."
539 (guix-info-insert-val-default number 'guix-generation-info-number)
540 (guix-info-insert-indent)
541 (guix-info-insert-action-button
542 "Packages"
543 (lambda (btn)
544 (guix-package-list-get-show 'generation
545 (button-get btn 'number)))
546 "Show installed packages for this generation"
547 'number number)
548 (guix-info-insert-indent)
549 (guix-info-insert-action-button
550 "Delete"
551 (lambda (btn) (error "Sorry, not implemented yet"))
552 "Delete this generation"))
553
554(provide 'guix-info)
555
556;;; guix-info.el ends here
diff --git a/emacs/guix-init.el.in b/emacs/guix-init.el.in
new file mode 100644
index 00000000000..4e627281875
--- /dev/null
+++ b/emacs/guix-init.el.in
@@ -0,0 +1,14 @@
1(require 'guix-autoloads)
2
3(defvar guix-load-path
4 (replace-regexp-in-string "${prefix}" "@prefix@" "@emacsuidir@")
5 "Directory with scheme files for \"guix.el\" package.")
6
7(defvar guix-default-profile
8 (concat (or (getenv "NIX_STATE_DIR") "@guix_localstatedir@/guix")
9 "/profiles/per-user/"
10 (getenv "USER")
11 "/guix-profile")
12 "Default Guix profile.")
13
14(provide 'guix-init)
diff --git a/emacs/guix-list.el b/emacs/guix-list.el
new file mode 100644
index 00000000000..0460d20f1bc
--- /dev/null
+++ b/emacs/guix-list.el
@@ -0,0 +1,586 @@
1;;; guix-list.el --- List buffers for displaying entries -*- lexical-binding: t -*-
2
3;; Copyright © 2014 Alex Kost <alezost@gmail.com>
4
5;; This file is part of GNU Guix.
6
7;; GNU Guix is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation, either version 3 of the License, or
10;; (at your option) any later version.
11
12;; GNU Guix is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with this program. If not, see <http://www.gnu.org/licenses/>.
19
20;;; Commentary:
21
22;; This file provides a list-like buffer for displaying information
23;; about Guix packages and generations.
24
25;;; Code:
26
27(require 'cl-lib)
28(require 'tabulated-list)
29(require 'guix-info)
30(require 'guix-history)
31(require 'guix-base)
32(require 'guix-utils)
33
34(defgroup guix-list nil
35 "General settings for list buffers."
36 :prefix "guix-list-"
37 :group 'guix)
38
39(defface guix-list-file-path
40 '((t :inherit guix-info-file-path))
41 "Face used for file paths."
42 :group 'guix-list)
43
44(defcustom guix-list-describe-warning-count 10
45 "The maximum number of entries for describing without a warning.
46If a user wants to describe more than this number of marked
47entries, he will be prompted for confirmation."
48 :type 'integer
49 :group 'guix-list)
50
51(defvar guix-list-column-format
52 `((package
53 (name 20 t)
54 (version 10 nil)
55 (outputs 13 t)
56 (installed 13 t)
57 (synopsis 30 nil))
58 (generation
59 (number 5
60 ,(lambda (a b) (guix-list-sort-numerically 0 a b))
61 :right-align t)
62 (time 20 t)
63 (path 30 t)))
64 "Columns displayed in list buffers.
65Each element of the list has a form:
66
67 (ENTRY-TYPE . ((PARAM WIDTH SORT . PROPS) ...))
68
69PARAM is the name of an entry parameter of ENTRY-TYPE. For the
70meaning of WIDTH, SORT and PROPS, see `tabulated-list-format'.")
71
72(defvar guix-list-column-titles
73 '((generation
74 (number . "N.")))
75 "Column titles for list buffers.
76Has the same structure as `guix-param-titles', but titles from
77this list have a priority.")
78
79(defvar guix-list-column-value-methods
80 '((package
81 (name . guix-package-list-get-name)
82 (synopsis . guix-list-get-one-line)
83 (description . guix-list-get-one-line)
84 (installed . guix-package-list-get-installed-outputs))
85 (generation
86 (time . guix-list-get-time)
87 (path . guix-list-get-file-path)))
88 "Methods for inserting parameter values in columns.
89Each element of the list has a form:
90
91 (ENTRY-TYPE . ((PARAM . FUN) ...))
92
93PARAM is the name of an entry parameter of ENTRY-TYPE.
94
95FUN is a function returning a value that will be inserted. The
96function is called with 2 arguments: the first one is the value
97of the parameter; the second argument is an entry info (alist of
98parameters and their values).")
99
100(defun guix-list-get-param-title (entry-type param)
101 "Return title of an ENTRY-TYPE entry parameter PARAM."
102 (or (guix-get-key-val guix-list-column-titles
103 entry-type param)
104 (guix-get-param-title entry-type param)))
105
106(defun guix-list-get-column-format (entry-type)
107 "Return column format for ENTRY-TYPE."
108 (guix-get-key-val guix-list-column-format entry-type))
109
110(defun guix-list-get-displayed-params (entry-type)
111 "Return list of parameters of ENTRY-TYPE that should be displayed."
112 (mapcar #'car
113 (guix-list-get-column-format entry-type)))
114
115(defun guix-list-get-sort-key (entry-type param &optional invert)
116 "Return suitable sort key for `tabulated-list-sort-key'.
117Define column title by ENTRY-TYPE and PARAM. If INVERT is
118non-nil, invert the sort."
119 (when (memq param (guix-list-get-displayed-params entry-type))
120 (cons (guix-list-get-param-title entry-type param) invert)))
121
122(defun guix-list-sort-numerically (column a b)
123 "Compare COLUMN of tabulated entries A and B numerically.
124It is a sort predicate for `tabulated-list-format'.
125Return non-nil, if B is bigger than A."
126 (cl-flet ((num (entry)
127 (string-to-number (aref (cadr entry) column))))
128 (> (num b) (num a))))
129
130(defun guix-list-make-tabulated-vector (entry-type fun)
131 "Call FUN on each column specification for ENTRY-TYPE.
132
133FUN is called with 2 argument: parameter name and column
134specification (see `guix-list-column-format').
135
136Return a vector made of values of FUN calls."
137 (apply #'vector
138 (mapcar (lambda (col-spec)
139 (funcall fun (car col-spec) (cdr col-spec)))
140 (guix-list-get-column-format entry-type))))
141
142(defun guix-list-get-list-format (entry-type)
143 "Return ENTRY-TYPE list specification for `tabulated-list-format'."
144 (guix-list-make-tabulated-vector
145 entry-type
146 (lambda (param spec)
147 (cons (guix-list-get-param-title entry-type param)
148 spec))))
149
150(defun guix-list-insert-entries (entries entry-type)
151 "Display ENTRIES of ENTRY-TYPE in the current list buffer.
152ENTRIES should have a form of `guix-entries'."
153 (setq tabulated-list-entries
154 (guix-list-get-tabulated-entries entries entry-type))
155 (tabulated-list-print))
156
157(defun guix-list-get-tabulated-entries (entries entry-type)
158 "Return list of values of ENTRY-TYPE for `tabulated-list-entries'.
159Values are taken from ENTRIES which should have the form of
160`guix-entries'."
161 (mapcar (lambda (entry)
162 (list (guix-get-key-val entry 'id)
163 (guix-list-get-tabulated-entry entry entry-type)))
164 entries))
165
166(defun guix-list-get-tabulated-entry (entry entry-type)
167 "Return array of values for `tabulated-list-entries'.
168Parameters are taken from ENTRY of ENTRY-TYPE."
169 (guix-list-make-tabulated-vector
170 entry-type
171 (lambda (param _)
172 (let ((val (guix-get-key-val entry param))
173 (fun (guix-get-key-val guix-list-column-value-methods
174 entry-type param)))
175 (if (and val fun)
176 (funcall fun val entry)
177 (guix-get-string val))))))
178
179(defun guix-list-get-one-line (str &optional _)
180 "Return one-line string from a multi-line STR."
181 (guix-get-one-line str))
182
183(defun guix-list-get-time (seconds &optional _)
184 "Return formatted time string from SECONDS."
185 (guix-get-time-string seconds))
186
187(defun guix-list-get-file-path (path &optional _)
188 "Return PATH button specification for `tabulated-list-entries'."
189 (list path
190 'face 'guix-list-file-path
191 'action (lambda (btn) (find-file (button-label btn)))
192 'follow-link t
193 'help-echo "Find file"))
194
195(defun guix-list-current-id ()
196 "Return ID of the current entry."
197 (or (tabulated-list-get-id)
198 (user-error "No entry here")))
199
200(defun guix-list-current-entry ()
201 "Return alist of the current entry info."
202 (guix-get-entry-by-id (guix-list-current-id) guix-entries))
203
204(defun guix-list-for-each-line (fun &rest args)
205 "Call FUN with ARGS for each entry line."
206 (or (derived-mode-p 'guix-list-mode)
207 (error "The current buffer is not in Guix List mode"))
208 (save-excursion
209 (goto-char (point-min))
210 (while (not (eobp))
211 (apply fun args)
212 (forward-line))))
213
214(defun guix-list-fold-lines (fun init)
215 "Fold over entry lines in the current list buffer.
216Call FUN with RESULT as argument for each line, using INIT as
217the initial value of RESULT. Return the final result."
218 (let ((res init))
219 (guix-list-for-each-line
220 (lambda () (setq res (funcall fun res))))
221 res))
222
223
224;;; Marking and sorting
225
226(defvar-local guix-list-marked nil
227 "List of the marked entries.
228Each element of the list has a form:
229
230 (ID MARK-NAME . ARGS)
231
232ID is an entry ID.
233MARK-NAME is a symbol from `guix-list-mark-alist'.
234ARGS is a list of additional values.")
235
236(defvar guix-list-mark-alist
237 '((empty . ?\s)
238 (general . ?*))
239 "Alist of available mark names and mark characters.")
240
241(defsubst guix-list-get-mark (name)
242 "Return mark character by its NAME."
243 (or (guix-get-key-val guix-list-mark-alist name)
244 (error "Mark '%S' not found" name)))
245
246(defsubst guix-list-get-mark-string (name)
247 "Return mark string by its NAME."
248 (string (guix-list-get-mark name)))
249
250(defun guix-list-current-mark ()
251 "Return mark character of the current line."
252 (char-after (line-beginning-position)))
253
254(defun guix-list-get-marked (&rest mark-names)
255 "Return list of specs of entries marked with any mark from MARK-NAMES.
256Entry specs are elements from `guix-list-marked' list.
257If MARK-NAMES are not specified, use all marks from
258`guix-list-mark-alist' except the `empty' one."
259 (or mark-names
260 (setq mark-names
261 (delq 'empty
262 (mapcar #'car guix-list-mark-alist))))
263 (cl-remove-if-not (lambda (assoc)
264 (memq (cadr assoc) mark-names))
265 guix-list-marked))
266
267(defun guix-list-get-marked-args (mark-name)
268 "Return list of (ID . ARGS) elements from lines marked with MARK-NAME.
269See `guix-list-marked' for the meaning of ARGS."
270 (mapcar (lambda (spec)
271 (let ((id (car spec))
272 (args (cddr spec)))
273 (cons id args)))
274 (guix-list-get-marked mark-name)))
275
276(defun guix-list-get-marked-id-list (&rest mark-names)
277 "Return list of IDs of entries marked with any mark from MARK-NAMES.
278See `guix-list-get-marked' for details."
279 (mapcar #'car (apply #'guix-list-get-marked mark-names)))
280
281(defun guix-list-mark (mark-name &optional advance &rest args)
282 "Put a mark on the current line.
283Also add the current entry to `guix-list-marked' using its ID and ARGS.
284MARK-NAME is a symbol from `guix-list-mark-alist'.
285If ADVANCE is non-nil, move forward by one line after marking.
286Interactively, put a general mark and move to the next line."
287 (interactive '(general t))
288 (let ((id (guix-list-current-id)))
289 (if (eq mark-name 'empty)
290 (setq guix-list-marked (assq-delete-all id guix-list-marked))
291 (let ((assoc (assq id guix-list-marked))
292 (val (cons mark-name args)))
293 (if assoc
294 (setcdr assoc val)
295 (push (cons id val) guix-list-marked)))))
296 (tabulated-list-put-tag (guix-list-get-mark-string mark-name)
297 advance))
298
299(defun guix-list-mark-all (mark-name)
300 "Mark all lines with MARK-NAME mark.
301MARK-NAME is a symbol from `guix-list-mark-alist'.
302Interactively, put a general mark on all lines."
303 (interactive '(general))
304 (guix-list-for-each-line #'guix-list-mark mark-name))
305
306(defun guix-list-unmark ()
307 "Unmark the current line and move to the next line."
308 (interactive)
309 (guix-list-mark 'empty t))
310
311(defun guix-list-unmark-backward ()
312 "Move up one line and unmark it."
313 (interactive)
314 (forward-line -1)
315 (guix-list-mark 'empty))
316
317(defun guix-list-unmark-all ()
318 "Unmark all lines."
319 (interactive)
320 (guix-list-mark-all 'empty))
321
322(defun guix-list-restore-marks ()
323 "Put marks according to `guix-list-mark-alist'."
324 (guix-list-for-each-line
325 (lambda ()
326 (let ((mark-name (car (guix-get-key-val guix-list-marked
327 (guix-list-current-id)))))
328 (tabulated-list-put-tag
329 (guix-list-get-mark-string (or mark-name 'empty)))))))
330
331(defun guix-list-sort (&optional n)
332 "Sort guix list entries by the column at point.
333With a numeric prefix argument N, sort the Nth column.
334Same as `tabulated-list-sort', but also restore marks after sorting."
335 (interactive "P")
336 (tabulated-list-sort n)
337 (guix-list-restore-marks))
338
339
340(defvar guix-list-mode-map
341 (let ((map (make-sparse-keymap)))
342 (set-keymap-parent map tabulated-list-mode-map)
343 (define-key map (kbd "m") 'guix-list-mark)
344 (define-key map (kbd "*") 'guix-list-mark)
345 (define-key map (kbd "M") 'guix-list-mark-all)
346 (define-key map (kbd "u") 'guix-list-unmark)
347 (define-key map (kbd "U") 'guix-list-unmark-all)
348 (define-key map (kbd "DEL") 'guix-list-unmark-backward)
349 (define-key map [remap tabulated-list-sort] 'guix-list-sort)
350 map)
351 "Parent keymap for list buffers.")
352
353(define-derived-mode guix-list-mode tabulated-list-mode "Guix-List"
354 "Parent mode for displaying information in list buffers."
355 (setq tabulated-list-padding 2))
356
357(defmacro guix-list-define-entry-type (entry-type &rest args)
358 "Define common stuff for displaying ENTRY-TYPE entries in list buffers.
359
360Remaining argument (ARGS) should have a form [KEYWORD VALUE] ... The
361following keywords are available:
362
363 - `:sort-key' - default sort key for the tabulated list buffer.
364
365 - `:invert-sort' - if non-nil, invert initial sort.
366
367 - `:marks' - default value for the defined
368 `guix-ENTRY-TYPE-mark-alist' variable.
369
370This macro defines the following functions:
371
372 - `guix-ENTRY-TYPE-describe' - display marked entries in info buffer.
373
374 - `guix-ENTRY-TYPE-mark-MARK-NAME' functions for each mark
375 specified in `:marks' argument."
376 (let* ((entry-type-str (symbol-name entry-type))
377 (entry-str (concat entry-type-str " entries"))
378 (prefix (concat "guix-" entry-type-str "-list"))
379 (mode-str (concat prefix "-mode"))
380 (init-fun (intern (concat prefix "-mode-initialize")))
381 (describe-fun (intern (concat prefix "-describe")))
382 (marks-var (intern (concat prefix "-mark-alist")))
383 (marks-val nil)
384 (sort-key nil)
385 (invert-sort nil))
386
387 ;; Process the keyword args.
388 (while (keywordp (car args))
389 (pcase (pop args)
390 (`:sort-key (setq sort-key (pop args)))
391 (`:invert-sort (setq invert-sort (pop args)))
392 (`:marks (setq marks-val (pop args)))
393 (_ (pop args))))
394
395 `(progn
396 (defvar ,marks-var ',marks-val
397 ,(concat "Alist of additional marks for `" mode-str "'.\n"
398 "Marks from this list are added to `guix-list-mark-alist'."))
399
400 ,@(mapcar (lambda (mark-spec)
401 (let* ((mark-name (car mark-spec))
402 (mark-name-str (symbol-name mark-name)))
403 `(defun ,(intern (concat prefix "-mark-" mark-name-str "-simple")) ()
404 ,(concat "Put '" mark-name-str "' mark and move to the next line.\n"
405 "Also add the current entry to `guix-list-marked'.")
406 (interactive)
407 (guix-list-mark ',mark-name t))))
408 marks-val)
409
410 (defun ,describe-fun (&optional arg)
411 ,(concat "Describe " entry-str " marked with a general mark.\n"
412 "If no entry is marked, describe the current " entry-type-str ".\n"
413 "With prefix (if ARG is non-nil), describe the " entry-str "\n"
414 "marked with any mark.")
415 (interactive "P")
416 (let* ((ids (or (apply #'guix-list-get-marked-id-list
417 (unless arg '(general)))
418 (list (guix-list-current-id))))
419 (count (length ids)))
420 (when (or (<= count guix-list-describe-warning-count)
421 (y-or-n-p (format "Do you really want to describe %d entries? "
422 count)))
423 (,(intern (concat "guix-" entry-type-str "-info-get-show"))
424 'id ids))))
425
426 (defun ,init-fun ()
427 ,(concat "Initial settings for `" mode-str "'.")
428 ,(when sort-key
429 `(setq tabulated-list-sort-key
430 (guix-list-get-sort-key
431 ',entry-type ',sort-key ,invert-sort)))
432 (setq tabulated-list-format
433 (guix-list-get-list-format ',entry-type))
434 (setq-local guix-list-mark-alist
435 (append guix-list-mark-alist ,marks-var))
436 (tabulated-list-init-header)))))
437
438(put 'guix-list-define-entry-type 'lisp-indent-function 'defun)
439
440
441;;; Displaying packages
442
443(guix-define-buffer-type list package)
444
445(guix-list-define-entry-type package
446 :sort-key name
447 :marks ((install . ?I)
448 (upgrade . ?U)
449 (delete . ?D)))
450
451(defface guix-package-list-obsolete
452 '((t :inherit guix-package-info-obsolete))
453 "Face used if a package is obsolete."
454 :group 'guix-package-list)
455
456(defcustom guix-package-list-generation-marking-enabled nil
457 "If non-nil, allow putting marks in a list with 'generation packages'.
458
459By default this is disabled, because it may be confusing. For
460example a package is installed in some generation, so a user can
461mark it for deletion in the list of packages from this
462generation, but the package may not be installed in the latest
463generation, so actually it cannot be deleted.
464
465If you managed to understand the explanation above or if you
466really know what you do or if you just don't care, you can set
467this variable to t. It should not do much harm anyway (most
468likely)."
469 :type 'boolean
470 :group 'guix-package-list)
471
472(let ((map guix-package-list-mode-map))
473 (define-key map (kbd "RET") 'guix-package-list-describe)
474 (define-key map (kbd "x") 'guix-package-list-execute)
475 (define-key map (kbd "i") 'guix-package-list-mark-install)
476 (define-key map (kbd "^") 'guix-package-list-mark-upgrade)
477 (define-key map (kbd "d") 'guix-package-list-mark-delete))
478
479(defun guix-package-list-get-name (name entry)
480 "Return NAME of the package ENTRY.
481Colorize it with `guix-package-list-obsolete' if needed."
482 (guix-get-string name
483 (when (guix-get-key-val entry 'obsolete)
484 'guix-package-list-obsolete)))
485
486(defun guix-package-list-get-installed-outputs (installed &optional _)
487 "Return string with outputs from INSTALLED entries."
488 (guix-get-string
489 (mapcar (lambda (entry)
490 (guix-get-key-val entry 'output))
491 installed)))
492
493(defun guix-package-list-marking-check ()
494 "Signal an error if marking is disabled for the current buffer."
495 (when (and (not guix-package-list-generation-marking-enabled)
496 (derived-mode-p 'guix-package-list-mode)
497 (eq guix-search-type 'generation))
498 (error "Action marks are disabled for lists of 'generation packages'")))
499
500(defun guix-package-list-mark-install (&optional arg)
501 "Mark the current package for installation and move to the next line.
502With ARG, prompt for the outputs to install (several outputs may
503be separated with \",\")."
504 (interactive "P")
505 (guix-package-list-marking-check)
506 (let* ((entry (guix-list-current-entry))
507 (available (guix-get-key-val entry 'outputs))
508 (installed (guix-get-installed-outputs entry))
509 (to-install (if arg
510 (guix-completing-read-multiple
511 "Output(s) to install: " available nil t)
512 '("out")))
513 (to-install (cl-set-difference to-install installed
514 :test #'string=)))
515 (if to-install
516 (apply #'guix-list-mark 'install t to-install)
517 (user-error "This package is already installed"))))
518
519(defun guix-package-list-mark-delete (&optional arg)
520 "Mark the current package for deletion and move to the next line.
521With ARG, prompt for the outputs to delete (several outputs may
522be separated with \",\")."
523 (interactive "P")
524 (guix-package-list-marking-check)
525 (let* ((entry (guix-list-current-entry))
526 (installed (guix-get-installed-outputs entry)))
527 (or installed
528 (user-error "This package is not installed"))
529 (let ((to-delete (when arg
530 (guix-completing-read-multiple
531 "Output(s) to delete: " installed nil t))))
532 (if to-delete
533 (apply #'guix-list-mark 'delete t to-delete)
534 (guix-package-list-mark-delete-simple)))))
535
536(defun guix-package-list-mark-upgrade ()
537 "Mark the current package for upgrading and move to the next line."
538 (interactive)
539 (guix-package-list-marking-check)
540 (let ((entry (guix-list-current-entry)))
541 (or (guix-get-installed-outputs entry)
542 (user-error "This package is not installed"))
543 (when (or (guix-get-key-val entry 'obsolete)
544 (y-or-n-p "This package is not obsolete. Try to upgrade it anyway? "))
545 (guix-package-list-mark-upgrade-simple))))
546
547(defun guix-package-list-execute ()
548 "Perform actions on the marked packages."
549 (interactive)
550 (let ((actions (delq nil
551 (mapcar #'guix-package-list-make-action
552 '(install delete upgrade)))))
553 (if actions
554 (apply #'guix-process-package-actions actions)
555 (user-error "No operations specified"))))
556
557(defun guix-package-list-make-action (action-type)
558 "Return action specification for the packages marked with ACTION-TYPE.
559Return nil, if there are no packages marked with ACTION-TYPE.
560The specification is suitable for `guix-process-package-actions'."
561 (let ((specs (guix-list-get-marked-args action-type)))
562 (and specs (cons action-type specs))))
563
564
565;;; Displaying generations
566
567(guix-define-buffer-type list generation)
568
569(guix-list-define-entry-type generation
570 :sort-key number
571 :invert-sort t
572 :marks ((delete . ?D)))
573
574(let ((map guix-generation-list-mode-map))
575 (define-key map (kbd "RET") 'guix-generation-list-show-packages)
576 (define-key map (kbd "i") 'guix-generation-list-describe)
577 (define-key map (kbd "d") 'guix-generation-list-mark-delete-simple))
578
579(defun guix-generation-list-show-packages ()
580 "List installed packages for the generation at point."
581 (interactive)
582 (guix-package-list-get-show 'generation (guix-list-current-id)))
583
584(provide 'guix-list)
585
586;;; guix-list.el ends here
diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm
new file mode 100644
index 00000000000..1383d088306
--- /dev/null
+++ b/emacs/guix-main.scm
@@ -0,0 +1,603 @@
1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
3;;;
4;;; This file is part of GNU Guix.
5;;;
6;;; GNU Guix is free software; you can redistribute it and/or modify it
7;;; under the terms of the GNU General Public License as published by
8;;; the Free Software Foundation; either version 3 of the License, or (at
9;;; your option) any later version.
10;;;
11;;; GNU Guix is distributed in the hope that it will be useful, but
12;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
18
19;;; Commentary:
20
21;; Information about packages and generations is passed to the elisp
22;; side in the form of alists of parameters (such as ‘name’ or
23;; ‘version’) and their values. These alists are called "entries" in
24;; this code. So to distinguish, just "package" in the name of a
25;; function means a guile object ("package" record) while
26;; "package entry" means alist of package parameters and values (see
27;; ‘package-param-alist’).
28;;
29;; "Entry" is probably not the best name for such alists, because there
30;; already exists "manifest-entry" which has nothing to do with the
31;; "entry" described above. Do not be confused :)
32
33;; ‘get-entries’ function is the “entry point” for the elisp side to get
34;; information about packages and generations.
35
36;; Since name/version pair is not necessarily unique, we use
37;; `object-address' to identify a package (for ‘id’ parameter), if
38;; possible. However for the obsolete packages (that can be found in
39;; installed manifest but not in a package directory), ‘id’ parameter is
40;; still "name-version" string. So ‘id’ package parameter in the code
41;; below is either an object-address number or a full-name string.
42;;
43;; Important: as object addresses live only during guile session, elisp
44;; part should take care about updating information after "Guix REPL" is
45;; restarted (TODO!)
46;;
47;; ‘installed’ parameter of a package entry contains information about
48;; installed outputs. It is a list of "installed entries" (see
49;; ‘package-installed-param-alist’).
50
51;; To speed-up the process of getting information, the following
52;; auxiliary variables are used:
53;;
54;; - `%packages' - VHash of "package address"/"package" pairs.
55;;
56;; - `%package-table' - Hash table of
57;; "name+version key"/"list of packages" pairs.
58;;
59;; - `%current-manifest-entries-table' - Hash table of
60;; "name+version key"/"list of manifest entries" pairs. This variable
61;; is set by `set-current-manifest-maybe!' when it is needed.
62
63;;; Code:
64
65(use-modules
66 (ice-9 vlist)
67 (ice-9 match)
68 (srfi srfi-1)
69 (srfi srfi-11)
70 (srfi srfi-19)
71 (srfi srfi-26)
72 (guix)
73 (guix packages)
74 (guix profiles)
75 (guix licenses)
76 (guix utils)
77 (guix ui)
78 (guix scripts package)
79 (gnu packages))
80
81(define-syntax-rule (first-or-false lst)
82 (and (not (null? lst))
83 (first lst)))
84
85(define full-name->name+version package-name->name+version)
86(define (name+version->full-name name version)
87 (string-append name "-" version))
88
89(define* (make-package-specification name #:optional version output)
90 (let ((full-name (if version
91 (name+version->full-name name version)
92 name)))
93 (if output
94 (string-append full-name ":" output)
95 full-name)))
96
97(define name+version->key cons)
98(define key->name+version car+cdr)
99
100(define %current-manifest #f)
101(define %current-manifest-entries-table #f)
102
103(define %packages
104 (fold-packages (lambda (pkg res)
105 (vhash-consq (object-address pkg) pkg res))
106 vlist-null))
107
108(define %package-table
109 (let ((table (make-hash-table (vlist-length %packages))))
110 (vlist-for-each
111 (lambda (elem)
112 (match elem
113 ((address . pkg)
114 (let* ((key (name+version->key (package-name pkg)
115 (package-version pkg)))
116 (ref (hash-ref table key)))
117 (hash-set! table key
118 (if ref (cons pkg ref) (list pkg)))))))
119 %packages)
120 table))
121
122;; FIXME get rid of this function!
123(define (set-current-manifest-maybe! profile)
124 (define (manifest-entries->hash-table entries)
125 (let ((entries-table (make-hash-table (length entries))))
126 (for-each (lambda (entry)
127 (let* ((key (name+version->key
128 (manifest-entry-name entry)
129 (manifest-entry-version entry)))
130 (ref (hash-ref entries-table key)))
131 (hash-set! entries-table key
132 (if ref (cons entry ref) (list entry)))))
133 entries)
134 entries-table))
135
136 (when profile
137 (let ((manifest (profile-manifest profile)))
138 (unless (and (manifest? %current-manifest)
139 (equal? manifest %current-manifest))
140 (set! %current-manifest manifest)
141 (set! %current-manifest-entries-table
142 (manifest-entries->hash-table
143 (manifest-entries manifest)))))))
144
145(define (manifest-entries-by-name+version name version)
146 (or (hash-ref %current-manifest-entries-table
147 (name+version->key name version))
148 '()))
149
150(define (packages-by-name+version name version)
151 (or (hash-ref %package-table
152 (name+version->key name version))
153 '()))
154
155(define (packages-by-full-name full-name)
156 (call-with-values
157 (lambda () (full-name->name+version full-name))
158 packages-by-name+version))
159
160(define (package-by-address address)
161 (and=> (vhash-assq address %packages)
162 cdr))
163
164(define (packages-by-id id)
165 (if (integer? id)
166 (let ((pkg (package-by-address id)))
167 (if pkg (list pkg) '()))
168 (packages-by-full-name id)))
169
170(define (package-by-id id)
171 (first-or-false (packages-by-id id)))
172
173(define (newest-package-by-id id)
174 (and=> (id->name+version id)
175 (lambda (name)
176 (first-or-false (find-best-packages-by-name name #f)))))
177
178(define (id->name+version id)
179 (if (integer? id)
180 (and=> (package-by-address id)
181 (lambda (pkg)
182 (values (package-name pkg)
183 (package-version pkg))))
184 (full-name->name+version id)))
185
186(define (fold-manifest-entries proc init)
187 "Fold over `%current-manifest-entries-table'.
188Call (PROC NAME VERSION ENTRIES RESULT) for each element of the hash
189table, using INIT as the initial value of RESULT."
190 (hash-fold (lambda (key entries res)
191 (let-values (((name version) (key->name+version key)))
192 (proc name version entries res)))
193 init
194 %current-manifest-entries-table))
195
196(define (fold-object proc init obj)
197 (fold proc init
198 (if (list? obj) obj (list obj))))
199
200(define* (object-transformer param-alist #:optional (params '()))
201 "Return function for transforming an object into alist of parameters/values.
202
203PARAM-ALIST is alist of available object parameters (symbols) and functions
204returning values of these parameters. Each function is called with object as
205a single argument.
206
207PARAMS is list of parameters from PARAM-ALIST that should be returned by a
208resulting function. If PARAMS is not specified or is an empty list, use all
209available parameters.
210
211Example:
212
213 (let ((alist `((plus1 . ,1+) (minus1 . ,1-) (mul2 . ,(cut * 2 <>))))
214 (number->alist (object-transformer alist '(plus1 mul2))))
215 (number->alist 8))
216 =>
217 ((plus1 . 9) (mul2 . 16))
218"
219 (let ((alist (let ((use-all-params (null? params)))
220 (filter-map (match-lambda
221 ((param . fun)
222 (and (or use-all-params
223 (memq param params))
224 (cons param fun)))
225 (_ #f))
226 param-alist))))
227 (lambda (object)
228 (map (match-lambda
229 ((param . fun)
230 (cons param (fun object))))
231 alist))))
232
233(define package-installed-param-alist
234 (list
235 (cons 'output manifest-entry-output)
236 (cons 'path manifest-entry-item)
237 (cons 'dependencies manifest-entry-dependencies)))
238
239(define manifest-entry->installed-entry
240 (object-transformer package-installed-param-alist))
241
242(define (manifest-entries->installed-entries entries)
243 (map manifest-entry->installed-entry entries))
244
245(define (installed-entries-by-name+version name version)
246 (manifest-entries->installed-entries
247 (manifest-entries-by-name+version name version)))
248
249(define (installed-entries-by-package package)
250 (installed-entries-by-name+version (package-name package)
251 (package-version package)))
252
253(define (package-inputs-names inputs)
254 "Return list of full names of the packages from package INPUTS."
255 (filter-map (match-lambda
256 ((_ (? package? package))
257 (package-full-name package))
258 (_ #f))
259 inputs))
260
261(define (package-license-names package)
262 "Return list of license names of the PACKAGE."
263 (fold-object (lambda (license res)
264 (if (license? license)
265 (cons (license-name license) res)
266 res))
267 '()
268 (package-license package)))
269
270(define (package-unique? package)
271 "Return #t if PACKAGE is a single package with such name/version."
272 (null? (cdr (packages-by-name+version (package-name package)
273 (package-version package)))))
274
275(define package-param-alist
276 (list
277 (cons 'id object-address)
278 (cons 'name package-name)
279 (cons 'version package-version)
280 (cons 'license package-license-names)
281 (cons 'synopsis package-synopsis)
282 (cons 'description package-description)
283 (cons 'home-url package-home-page)
284 (cons 'outputs package-outputs)
285 (cons 'non-unique (negate package-unique?))
286 (cons 'inputs (lambda (pkg) (package-inputs-names
287 (package-inputs pkg))))
288 (cons 'native-inputs (lambda (pkg) (package-inputs-names
289 (package-native-inputs pkg))))
290 (cons 'propagated-inputs (lambda (pkg) (package-inputs-names
291 (package-propagated-inputs pkg))))
292 (cons 'location (lambda (pkg) (location->string
293 (package-location pkg))))
294 (cons 'installed installed-entries-by-package)))
295
296(define (package-param package param)
297 "Return the value of a PACKAGE PARAM."
298 (define (accessor param)
299 (and=> (assq param package-param-alist)
300 cdr))
301 (and=> (accessor param)
302 (cut <> package)))
303
304(define (matching-package-entries ->entry predicate)
305 "Return list of package entries for the matching packages.
306PREDICATE is called on each package."
307 (fold-packages (lambda (pkg res)
308 (if (predicate pkg)
309 (cons (->entry pkg) res)
310 res))
311 '()))
312
313(define (make-obsolete-package-entry name version entries)
314 "Return package entry for an obsolete package with NAME and VERSION.
315ENTRIES is a list of manifest entries used to get installed info."
316 `((id . ,(name+version->full-name name version))
317 (name . ,name)
318 (version . ,version)
319 (outputs . ,(map manifest-entry-output entries))
320 (obsolete . #t)
321 (installed . ,(manifest-entries->installed-entries entries))))
322
323(define (package-entries-by-name+version ->entry name version)
324 "Return list of package entries for packages with NAME and VERSION."
325 (let ((packages (packages-by-name+version name version)))
326 (if (null? packages)
327 (let ((entries (manifest-entries-by-name+version name version)))
328 (if (null? entries)
329 '()
330 (list (make-obsolete-package-entry name version entries))))
331 (map ->entry packages))))
332
333(define (package-entries-by-spec profile ->entry spec)
334 "Return list of package entries for packages with name specification SPEC."
335 (set-current-manifest-maybe! profile)
336 (let-values (((name version)
337 (full-name->name+version spec)))
338 (if version
339 (package-entries-by-name+version ->entry name version)
340 (matching-package-entries
341 ->entry
342 (lambda (pkg) (string=? name (package-name pkg)))))))
343
344(define (package-entries-by-regexp profile ->entry regexp match-params)
345 "Return list of package entries for packages matching REGEXP string.
346MATCH-PARAMS is a list of parameters that REGEXP can match."
347 (define (package-match? package regexp)
348 (any (lambda (param)
349 (let ((val (package-param package param)))
350 (and (string? val) (regexp-exec regexp val))))
351 match-params))
352
353 (set-current-manifest-maybe! profile)
354 (let ((re (make-regexp regexp regexp/icase)))
355 (matching-package-entries ->entry (cut package-match? <> re))))
356
357(define (package-entries-by-ids profile ->entry ids)
358 "Return list of package entries for packages matching KEYS.
359IDS may be an object-address, a full-name or a list of such elements."
360 (set-current-manifest-maybe! profile)
361 (fold-object
362 (lambda (id res)
363 (if (integer? id)
364 (let ((pkg (package-by-address id)))
365 (if pkg
366 (cons (->entry pkg) res)
367 res))
368 (let ((entries (package-entries-by-spec #f ->entry id)))
369 (if (null? entries)
370 res
371 (append res entries)))))
372 '()
373 ids))
374
375(define (newest-available-package-entries profile ->entry)
376 "Return list of package entries for the newest available packages."
377 (set-current-manifest-maybe! profile)
378 (vhash-fold (lambda (name elem res)
379 (match elem
380 ((version newest pkgs ...)
381 (cons (->entry newest) res))))
382 '()
383 (find-newest-available-packages)))
384
385(define (all-available-package-entries profile ->entry)
386 "Return list of package entries for all available packages."
387 (set-current-manifest-maybe! profile)
388 (matching-package-entries ->entry (const #t)))
389
390(define (manifest-package-entries ->entry)
391 "Return list of package entries for the current manifest."
392 (fold-manifest-entries
393 (lambda (name version entries res)
394 ;; We don't care about duplicates for the list of
395 ;; installed packages, so just take any package (car)
396 ;; matching name+version
397 (cons (car (package-entries-by-name+version ->entry name version))
398 res))
399 '()))
400
401(define (installed-package-entries profile ->entry)
402 "Return list of package entries for all installed packages."
403 (set-current-manifest-maybe! profile)
404 (manifest-package-entries ->entry))
405
406(define (generation-package-entries profile ->entry generation)
407 "Return list of package entries for packages from GENERATION."
408 (set-current-manifest-maybe!
409 (generation-file-name profile generation))
410 (manifest-package-entries ->entry))
411
412(define (obsolete-package-entries profile _)
413 "Return list of package entries for obsolete packages."
414 (set-current-manifest-maybe! profile)
415 (fold-manifest-entries
416 (lambda (name version entries res)
417 (let ((packages (packages-by-name+version name version)))
418 (if (null? packages)
419 (cons (make-obsolete-package-entry name version entries) res)
420 res)))
421 '()))
422
423
424;;; Generation entries
425
426(define (profile-generations profile)
427 "Return list of generations for PROFILE."
428 (let ((generations (generation-numbers profile)))
429 (if (equal? generations '(0))
430 '()
431 generations)))
432
433(define (generation-param-alist profile)
434 "Return alist of generation parameters and functions for PROFILE."
435 (list
436 (cons 'id identity)
437 (cons 'number identity)
438 (cons 'prev-number (cut previous-generation-number profile <>))
439 (cons 'path (cut generation-file-name profile <>))
440 (cons 'time (lambda (gen)
441 (time-second (generation-time profile gen))))))
442
443(define (matching-generation-entries profile ->entry predicate)
444 "Return list of generation entries for the matching generations.
445PREDICATE is called on each generation."
446 (filter-map (lambda (gen)
447 (and (predicate gen) (->entry gen)))
448 (profile-generations profile)))
449
450(define (last-generation-entries profile ->entry number)
451 "Return list of last NUMBER generation entries.
452If NUMBER is 0 or less, return all generation entries."
453 (let ((generations (profile-generations profile))
454 (number (if (<= number 0) +inf.0 number)))
455 (map ->entry
456 (if (> (length generations) number)
457 (list-head (reverse generations) number)
458 generations))))
459
460(define (all-generation-entries profile ->entry)
461 "Return list of all generation entries."
462 (last-generation-entries profile ->entry +inf.0))
463
464(define (generation-entries-by-ids profile ->entry ids)
465 "Return list of generation entries for generations matching IDS.
466IDS is a list of generation numbers."
467 (matching-generation-entries profile ->entry (cut memq <> ids)))
468
469
470;;; Getting package/generation entries
471
472(define %package-entries-functions
473 (alist->vhash
474 `((id . ,package-entries-by-ids)
475 (name . ,package-entries-by-spec)
476 (regexp . ,package-entries-by-regexp)
477 (all-available . ,all-available-package-entries)
478 (newest-available . ,newest-available-package-entries)
479 (installed . ,installed-package-entries)
480 (obsolete . ,obsolete-package-entries)
481 (generation . ,generation-package-entries))
482 hashq))
483
484(define %generation-entries-functions
485 (alist->vhash
486 `((id . ,generation-entries-by-ids)
487 (last . ,last-generation-entries)
488 (all . ,all-generation-entries))
489 hashq))
490
491(define (get-entries profile params entry-type search-type search-vals)
492 "Return list of entries.
493ENTRY-TYPE and SEARCH-TYPE define a search function that should be
494applied to PARAMS and VALS."
495 (let-values (((vhash ->entry)
496 (case entry-type
497 ((package)
498 (values %package-entries-functions
499 (object-transformer
500 package-param-alist params)))
501 ((generation)
502 (values %generation-entries-functions
503 (object-transformer
504 (generation-param-alist profile) params)))
505 (else (format (current-error-port)
506 "Wrong entry type '~a'" entry-type)))))
507 (match (vhash-assq search-type vhash)
508 ((key . fun)
509 (apply fun profile ->entry search-vals))
510 (_ '()))))
511
512
513;;; Actions
514
515(define* (package->manifest-entry* package #:optional output)
516 (and package
517 (begin
518 (check-package-freshness package)
519 (package->manifest-entry package output))))
520
521(define* (make-install-manifest-entries id #:optional output)
522 (package->manifest-entry* (package-by-id id) output))
523
524(define* (make-upgrade-manifest-entries id #:optional output)
525 (package->manifest-entry* (newest-package-by-id id) output))
526
527(define* (make-manifest-pattern id #:optional output)
528 "Make manifest pattern from a package ID and OUTPUT."
529 (let-values (((name version)
530 (id->name+version id)))
531 (and name version
532 (manifest-pattern
533 (name name)
534 (version version)
535 (output output)))))
536
537(define (convert-action-pattern pattern proc)
538 "Convert action PATTERN into a list of objects returned by PROC.
539PROC is called: (PROC ID) or (PROC ID OUTPUT)."
540 (match pattern
541 ((id . outputs)
542 (if (null? outputs)
543 (let ((obj (proc id)))
544 (if obj (list obj) '()))
545 (filter-map (cut proc id <>)
546 outputs)))
547 (_ '())))
548
549(define (convert-action-patterns patterns proc)
550 (append-map (cut convert-action-pattern <> proc)
551 patterns))
552
553(define* (process-package-actions
554 profile #:key (install '()) (upgrade '()) (remove '())
555 (use-substitutes? #t) dry-run?)
556 "Perform package actions.
557
558INSTALL, UPGRADE, REMOVE are lists of 'package action patterns'.
559Each pattern should have the following form:
560
561 (ID . OUTPUTS)
562
563ID is an object address or a full-name of a package.
564OUTPUTS is a list of package outputs (may be an empty list)."
565 (format #t "The process begins ...~%")
566 (let* ((install (append
567 (convert-action-patterns
568 install make-install-manifest-entries)
569 (convert-action-patterns
570 upgrade make-upgrade-manifest-entries)))
571 (remove (convert-action-patterns remove make-manifest-pattern))
572 (transaction (manifest-transaction (install install)
573 (remove remove)))
574 (manifest (profile-manifest profile))
575 (new-manifest (manifest-perform-transaction
576 manifest transaction)))
577 (unless (and (null? install) (null? remove))
578 (let* ((store (open-connection))
579 (derivation (run-with-store
580 store (profile-derivation new-manifest)))
581 (derivations (list derivation))
582 (new-profile (derivation->output-path derivation)))
583 (set-build-options store
584 #:use-substitutes? use-substitutes?)
585 (manifest-show-transaction store manifest transaction
586 #:dry-run? dry-run?)
587 (show-what-to-build store derivations
588 #:use-substitutes? use-substitutes?
589 #:dry-run? dry-run?)
590 (unless dry-run?
591 (let ((name (generation-file-name
592 profile
593 (+ 1 (generation-number profile)))))
594 (and (build-derivations store derivations)
595 (let* ((entries (manifest-entries new-manifest))
596 (count (length entries)))
597 (switch-symlinks name new-profile)
598 (switch-symlinks profile name)
599 (format #t (N_ "~a package in profile~%"
600 "~a packages in profile~%"
601 count)
602 count)))))))))
603
diff --git a/emacs/guix-utils.el b/emacs/guix-utils.el
new file mode 100644
index 00000000000..c1fe1a3a38d
--- /dev/null
+++ b/emacs/guix-utils.el
@@ -0,0 +1,160 @@
1;;; guix-utils.el --- General utility functions
2
3;; Copyright © 2014 Alex Kost <alezost@gmail.com>
4
5;; This file is part of GNU Guix.
6
7;; GNU Guix is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation, either version 3 of the License, or
10;; (at your option) any later version.
11
12;; GNU Guix is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with this program. If not, see <http://www.gnu.org/licenses/>.
19
20;;; Commentary:
21
22;; This file provides auxiliary general functions for guix.el package.
23
24;;; Code:
25
26;; (require 'cl-lib)
27
28(defvar guix-true-string "Yes")
29(defvar guix-false-string "–")
30(defvar guix-list-separator ", ")
31
32(defvar guix-time-format "%F %T"
33 "String used to format time values.
34For possible formats, see `format-time-string'.")
35
36(defun guix-get-string (val &optional face)
37 "Convert VAL into a string and return it.
38
39VAL can be an expression of any type.
40If VAL is t/nil, it is replaced with
41`guix-true-string'/`guix-false-string'.
42If VAL is list, its elements are concatenated using
43`guix-list-separator'.
44
45If FACE is non-nil, propertize returned string with this FACE."
46 (let ((str (cond
47 ((stringp val) val)
48 ((null val) guix-false-string)
49 ((eq t val) guix-true-string)
50 ((numberp val) (number-to-string val))
51 ((listp val) (mapconcat #'guix-get-string
52 val guix-list-separator))
53 (t (prin1-to-string val)))))
54 (if (and val face)
55 (propertize str 'face face)
56 str)))
57
58(defun guix-get-time-string (seconds)
59 "Return formatted time string from SECONDS.
60Use `guix-time-format'."
61 (format-time-string guix-time-format (seconds-to-time seconds)))
62
63(defun guix-get-one-line (str)
64 "Return one-line string from a multi-line STR."
65 (replace-regexp-in-string "\n" " " str))
66
67(defun guix-format-insert (val &optional face format)
68 "Convert VAL into a string and insert it at point.
69If FACE is non-nil, propertize VAL with FACE.
70If FORMAT is non-nil, format VAL with FORMAT."
71 (let ((str (guix-get-string val face)))
72 (insert (if format
73 (format format str)
74 str))))
75
76(defun guix-mapinsert (function sequence separator)
77 "Like `mapconcat' but for inserting text.
78Apply FUNCTION to each element of SEQUENCE, and insert SEPARATOR
79at point between each FUNCTION call."
80 (when sequence
81 (funcall function (car sequence))
82 (mapc (lambda (obj)
83 (insert separator)
84 (funcall function obj))
85 (cdr sequence))))
86
87(defun guix-insert-button (label face action &optional message
88 &rest properties)
89 "Make button with LABEL and insert it at point.
90Propertize button with FACE.
91ACTION is a function called when the button is pressed. It
92should accept button as the argument.
93MESSAGE is a button message.
94See `insert-text-button' for the meaning of PROPERTIES."
95 (if (null label)
96 (guix-format-insert nil)
97 (apply #'insert-text-button
98 label
99 'face face
100 'action action
101 'follow-link t
102 'help-echo message
103 properties)))
104
105(defun guix-split-insert (val &optional face col separator)
106 "Convert VAL into a string, split it and insert at point.
107
108If FACE is non-nil, propertize returned string with this FACE.
109
110If COL is non-nil and result string is a one-line string longer
111than COL, split it into several short lines.
112
113Separate inserted lines with SEPARATOR."
114 (if (null val)
115 (guix-format-insert nil)
116 (let ((strings (guix-split-string (guix-get-string val) col)))
117 (guix-mapinsert (lambda (str) (guix-format-insert str face))
118 strings
119 (or separator "")))))
120
121(defun guix-split-string (str &optional col)
122 "Split string STR by lines and return list of result strings.
123If COL is non-nil and STR is a one-line string longer than COL,
124split it into several short lines."
125 (let ((strings (split-string str "\n *")))
126 (if (and col
127 (null (cdr strings)) ; if not multi-line
128 (> (length str) col))
129 (split-string (guix-get-filled-string str col) "\n")
130 strings)))
131
132(defun guix-get-filled-string (str col)
133 "Return string by filling STR to column COL."
134 (with-temp-buffer
135 (insert str)
136 (let ((fill-column col))
137 (fill-region (point-min) (point-max)))
138 (buffer-string)))
139
140(defun guix-completing-read-multiple (prompt table &optional predicate
141 require-match initial-input
142 hist def inherit-input-method)
143 "Same as `completing-read-multiple' but remove duplicates in result."
144 (cl-remove-duplicates
145 (completing-read-multiple prompt table predicate
146 require-match initial-input
147 hist def inherit-input-method)
148 :test #'string=))
149
150(defun guix-get-key-val (alist &rest keys)
151 "Return value from ALIST by KEYS.
152ALIST is alist of alists of alists ... which can be consecutively
153accessed with KEYS."
154 (let ((val alist))
155 (dolist (key keys val)
156 (setq val (cdr (assq key val))))))
157
158(provide 'guix-utils)
159
160;;; guix-utils.el ends here
diff --git a/emacs/guix.el b/emacs/guix.el
new file mode 100644
index 00000000000..7336f6732e5
--- /dev/null
+++ b/emacs/guix.el
@@ -0,0 +1,141 @@
1;;; guix.el --- Interface for GNU Guix package manager
2
3;; Copyright © 2014 Alex Kost <alezost@gmail.com>
4
5;; Package-Requires: ((geiser "0.3"))
6;; Keywords: tools
7
8;; This file is part of GNU Guix.
9
10;; GNU Guix is free software; you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation, either version 3 of the License, or
13;; (at your option) any later version.
14
15;; GNU Guix is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with this program. If not, see <http://www.gnu.org/licenses/>.
22
23;;; Commentary:
24
25;; This package provides an interface for searching, listing and getting
26;; information about Guix packages and generations; and for
27;; installing/upgrading/removing packages.
28
29;;; Code:
30
31(require 'guix-list)
32(require 'guix-info)
33
34(defgroup guix nil
35 "Interface for Guix package manager."
36 :prefix "guix-"
37 :group 'external)
38
39(defcustom guix-list-single-package nil
40 "If non-nil, list a package even if it is the only matching result.
41If nil, show a single package in the info buffer."
42 :type 'boolean
43 :group 'guix)
44
45(defcustom guix-show-generations-function 'guix-generation-list-get-show
46 "Default function used to display generations."
47 :type '(choice (function-item guix-generation-list-get-show)
48 (function-item guix-generation-info-get-show))
49 :group 'guix)
50
51(defvar guix-search-params '(name synopsis description)
52 "Default list of package parameters for searching by regexp.")
53
54(defvar guix-search-history nil
55 "A history of minibuffer prompts.")
56
57(defun guix-get-show-packages (search-type &rest search-vals)
58 "Search for packages and show results.
59
60See `guix-get-entries' for the meaning of SEARCH-TYPE and
61SEARCH-VALS.
62
63Results are displayed in the list buffer, unless a single package
64is found and `guix-list-single-package' is nil."
65 (let* ((list-params (guix-package-list-get-params-for-receiving))
66 (packages (guix-get-entries 'package search-type
67 search-vals list-params)))
68 (if (or guix-list-single-package
69 (cdr packages))
70 (guix-package-list-set packages search-type search-vals)
71 (let ((info-params (guix-package-info-get-params-for-receiving)))
72 (unless (equal list-params info-params)
73 ;; If we don't have required info, we should receive it again
74 (setq packages (guix-get-entries 'package search-type
75 search-vals info-params))))
76 (guix-package-info-set packages search-type search-vals))))
77
78(defun guix-get-show-generations (search-type &rest search-vals)
79 "Search for generations and show results."
80 (apply guix-show-generations-function search-type search-vals))
81
82;;;###autoload
83(defun guix-search-by-name (name)
84 "Search for Guix packages by NAME.
85NAME is a string with name specification. It may optionally contain
86a version number. Examples: \"guile\", \"guile-2.0.11\"."
87 (interactive
88 (list (read-string "Package name: " nil 'guix-search-history)))
89 (guix-get-show-packages 'name name))
90
91;;;###autoload
92(defun guix-search-by-regexp (regexp &rest params)
93 "Search for Guix packages by REGEXP.
94PARAMS are package parameters that should be searched.
95If PARAMS are not specified, use `guix-search-params'."
96 (interactive
97 (list (read-string "Regexp: " nil 'guix-search-history)))
98 (or params (setq params guix-search-params))
99 (guix-get-show-packages 'regexp regexp params))
100
101;;;###autoload
102(defun guix-installed-packages ()
103 "Display information about installed Guix packages."
104 (interactive)
105 (guix-get-show-packages 'installed))
106
107;;;###autoload
108(defun guix-obsolete-packages ()
109 "Display information about obsolete Guix packages."
110 (interactive)
111 (guix-get-show-packages 'obsolete))
112
113;;;###autoload
114(defun guix-all-available-packages ()
115 "Display information about all available Guix packages."
116 (interactive)
117 (guix-get-show-packages 'all-available))
118
119;;;###autoload
120(defun guix-newest-available-packages ()
121 "Display information about the newest available Guix packages."
122 (interactive)
123 (guix-get-show-packages 'newest-available))
124
125;;;###autoload
126(defun guix-generations (&optional number)
127 "Display information about last NUMBER generations.
128If NUMBER is nil, display all generations.
129
130Generations can be displayed in a list or info buffers depending
131on `guix-show-generations-function'.
132
133Interactively, NUMBER is defined by a numeric prefix."
134 (interactive "P")
135 (if (numberp number)
136 (guix-get-show-generations 'last number)
137 (guix-get-show-generations 'all)))
138
139(provide 'guix)
140
141;;; guix.el ends here