summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Makefile.am8
-rw-r--r--configure.ac10
-rw-r--r--doc/contributing.texi3
-rw-r--r--doc/emacs.texi881
-rw-r--r--doc/guix.texi51
-rw-r--r--doc/htmlxref.cnf2
-rw-r--r--emacs/guix-about.el37
-rw-r--r--emacs/guix-backend.el393
-rw-r--r--emacs/guix-base.el377
-rw-r--r--emacs/guix-buffer.el624
-rw-r--r--emacs/guix-build-log.el381
-rw-r--r--emacs/guix-command.el830
-rw-r--r--emacs/guix-config.el.in44
-rw-r--r--emacs/guix-devel.el382
-rw-r--r--emacs/guix-entry.el59
-rw-r--r--emacs/guix-external.el88
-rw-r--r--emacs/guix-geiser.el126
-rw-r--r--emacs/guix-guile.el98
-rw-r--r--emacs/guix-help-vars.el108
-rw-r--r--emacs/guix-helper.scm.in65
-rw-r--r--emacs/guix-history.el92
-rw-r--r--emacs/guix-hydra-build.el362
-rw-r--r--emacs/guix-hydra-jobset.el162
-rw-r--r--emacs/guix-hydra.el367
-rw-r--r--emacs/guix-info.el482
-rw-r--r--emacs/guix-init.el3
-rw-r--r--emacs/guix-license.el65
-rw-r--r--emacs/guix-list.el585
-rw-r--r--emacs/guix-location.el79
-rw-r--r--emacs/guix-main.scm1163
-rw-r--r--emacs/guix-messages.el247
-rw-r--r--emacs/guix-pcomplete.el370
-rw-r--r--emacs/guix-popup.el48
-rw-r--r--emacs/guix-prettify.el210
-rw-r--r--emacs/guix-profiles.el77
-rw-r--r--emacs/guix-read.el147
-rw-r--r--emacs/guix-ui-generation.el456
-rw-r--r--emacs/guix-ui-license.el150
-rw-r--r--emacs/guix-ui-location.el83
-rw-r--r--emacs/guix-ui-package.el1191
-rw-r--r--emacs/guix-ui-system-generation.el105
-rw-r--r--emacs/guix-ui.el323
-rw-r--r--emacs/guix-utils.el609
-rw-r--r--emacs/local.mk77
-rw-r--r--gnu/packages/package-management.scm6
45 files changed, 14 insertions, 12012 deletions
diff --git a/Makefile.am b/Makefile.am
index 6cc3114d569..15939af12a8 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -465,10 +465,6 @@ AM_DISTCHECK_CONFIGURE_FLAGS = \
465 --with-nix-prefix="$(NIX_PREFIX)" \ 465 --with-nix-prefix="$(NIX_PREFIX)" \
466 --enable-daemon 466 --enable-daemon
467 467
468dist_emacsui_DATA = emacs/guix-main.scm
469nodist_emacsui_DATA = emacs/guix-helper.scm
470include emacs/local.mk
471
472# The self-contained tarball. 468# The self-contained tarball.
473guix-binary.%.tar.xz: 469guix-binary.%.tar.xz:
474 $(AM_V_GEN)GUIX_PACKAGE_PATH= \ 470 $(AM_V_GEN)GUIX_PACKAGE_PATH= \
@@ -548,10 +544,6 @@ AM_V_DOT = $(AM_V_DOT_$(V))
548AM_V_DOT_ = $(AM_V_DOT_$(AM_DEFAULT_VERBOSITY)) 544AM_V_DOT_ = $(AM_V_DOT_$(AM_DEFAULT_VERBOSITY))
549AM_V_DOT_0 = @echo " DOT " $@; 545AM_V_DOT_0 = @echo " DOT " $@;
550 546
551AM_V_EMACS = $(AM_V_EMACS_$(V))
552AM_V_EMACS_ = $(AM_V_EMACS_$(AM_DEFAULT_VERBOSITY))
553AM_V_EMACS_0 = @echo " EMACS " $@;
554
555AM_V_HELP2MAN = $(AM_V_HELP2MAN_$(V)) 547AM_V_HELP2MAN = $(AM_V_HELP2MAN_$(V))
556AM_V_HELP2MAN_ = $(AM_V_HELP2MAN_$(AM_DEFAULT_VERBOSITY)) 548AM_V_HELP2MAN_ = $(AM_V_HELP2MAN_$(AM_DEFAULT_VERBOSITY))
557AM_V_HELP2MAN_0 = @echo " HELP2MAN" $@; 549AM_V_HELP2MAN_0 = @echo " HELP2MAN" $@;
diff --git a/configure.ac b/configure.ac
index 4888624ba97..c3173d60c58 100644
--- a/configure.ac
+++ b/configure.ac
@@ -237,14 +237,4 @@ AC_CONFIG_FILES([test-env:build-aux/test-env.in], [chmod +x test-env])
237AC_CONFIG_FILES([pre-inst-env:build-aux/pre-inst-env.in], 237AC_CONFIG_FILES([pre-inst-env:build-aux/pre-inst-env.in],
238 [chmod +x pre-inst-env]) 238 [chmod +x pre-inst-env])
239 239
240dnl Emacs interface.
241AC_PATH_PROG([DOT_USER_PROGRAM], [dot], [dot])
242AM_PATH_LISPDIR
243AM_CONDITIONAL([HAVE_EMACS], [test "x$EMACS" != "xno"])
244
245emacsuidir="${guilemoduledir}/guix/emacs"
246AC_SUBST([emacsuidir])
247AC_CONFIG_FILES([emacs/guix-config.el
248 emacs/guix-helper.scm])
249
250AC_OUTPUT 240AC_OUTPUT
diff --git a/doc/contributing.texi b/doc/contributing.texi
index de08f9b3510..24db9a89e6f 100644
--- a/doc/contributing.texi
+++ b/doc/contributing.texi
@@ -187,9 +187,6 @@ facilities to directly operate on the syntax tree, such as raising an
187s-expression or wrapping it, swallowing or rejecting the following 187s-expression or wrapping it, swallowing or rejecting the following
188s-expression, etc. 188s-expression, etc.
189 189
190GNU Guix also comes with a minor mode that provides some additional
191functionality for Scheme buffers (@pxref{Emacs Development}).
192
193 190
194@node Coding Style 191@node Coding Style
195@section Coding Style 192@section Coding Style
diff --git a/doc/emacs.texi b/doc/emacs.texi
deleted file mode 100644
index 1ffb9f636ed..00000000000
--- a/doc/emacs.texi
+++ /dev/null
@@ -1,881 +0,0 @@
1@node Emacs Interface
2@chapter Emacs Interface
3
4@cindex Emacs
5GNU Guix comes with several useful modules (known as ``guix.el'') for
6GNU@tie{}Emacs which are intended to make an Emacs user interaction with
7Guix convenient and fun.
8
9@menu
10* Initial Setup: Emacs Initial Setup. Preparing @file{~/.emacs}.
11* Package Management: Emacs Package Management. Managing packages and generations.
12* Licenses: Emacs Licenses. Interface for licenses of Guix packages.
13* Package Source Locations: Emacs Package Locations. Interface for package location files.
14* Popup Interface: Emacs Popup Interface. Magit-like interface for guix commands.
15* Prettify Mode: Emacs Prettify. Abbreviating @file{/gnu/store/@dots{}} file names.
16* Build Log Mode: Emacs Build Log. Highlighting Guix build logs.
17* Completions: Emacs Completions. Completing @command{guix} shell command.
18* Development: Emacs Development. Tools for Guix developers.
19* Hydra: Emacs Hydra. Interface for Guix build farm.
20@end menu
21
22
23@node Emacs Initial Setup
24@section Initial Setup
25
26On the Guix System Distribution (@pxref{GNU Distribution}), ``guix.el''
27is ready to use, provided Guix is installed system-wide, which is the
28case by default. So if that is what you're using, you can happily skip
29this section and read about the fun stuff.
30
31If you're not yet a happy user of GuixSD, a little bit of setup is needed.
32To be able to use ``guix.el'', you need to install the following
33packages:
34
35@itemize
36@item
37@uref{http://www.gnu.org/software/emacs/, GNU Emacs}, version 24.3 or
38later;
39
40@item
41@uref{http://nongnu.org/geiser/, Geiser}, version 0.3 or later: it is
42used for interacting with the Guile process.
43
44@item
45@uref{https://github.com/magit/magit/, magit-popup library}. You
46already have this library if you use Magit 2.1.0 or later. This library
47is an optional dependency---it is required only for @kbd{M-x@tie{}guix}
48command (@pxref{Emacs Popup Interface}).
49
50@end itemize
51
52When it is done, ``guix.el'' may be configured by requiring
53@code{guix-autoloads} file. If you install Guix in your user profile,
54this auto-loading is done automatically by our Emacs package
55(@pxref{Application Setup}), so a universal recipe for configuring
56``guix.el'' is: @command{guix package -i guix}. If you do this, there
57is no need to read further.
58
59For the manual installation, you need to add the following code into
60your init file (@pxref{Init File,,, emacs, The GNU Emacs Manual}):
61
62@example
63(add-to-list 'load-path "/path/to/directory-with-guix.el")
64(require 'guix-autoloads nil t)
65@end example
66
67So the only thing you need to figure out is where the directory with
68elisp files for Guix is placed. It depends on how you installed Guix:
69
70@itemize
71@item
72If it was installed by a package manager of your distribution or by a
73usual @code{./configure && make && make install} command sequence, then
74elisp files are placed in a standard directory with Emacs packages
75(usually it is @file{/usr/share/emacs/site-lisp/}), which is already in
76@code{load-path}, so there is no need to add that directory there. Note
77that if you don't update this installation periodically, you may get an
78outdated Emacs code which does not work with the current Guile code of
79Guix.
80
81@item
82If you used a binary installation method (@pxref{Binary Installation}),
83then Guix is installed somewhere in the store, so the elisp files are
84placed in @file{/gnu/store/@dots{}-guix-0.8.2/share/emacs/site-lisp/} or
85alike. However it is not recommended to refer directly to a store
86directory, as it may be garbage-collected one day. So a better choice
87would be to install Guix using Guix itself with @command{guix package -i
88guix}.
89
90@item
91If you did not install Guix at all and prefer a hacking way
92(@pxref{Running Guix Before It Is Installed}), along with augmenting
93@code{load-path} you need to set @code{guix-load-path} variable to the
94same directory, so your final configuration will look like this:
95
96@example
97(let ((dir "/path/to/your-guix-git-tree/emacs"))
98 (add-to-list 'load-path dir)
99 (setq guix-load-path dir))
100(require 'guix-autoloads nil t)
101@end example
102@end itemize
103
104
105@node Emacs Package Management
106@section Package Management
107
108Once ``guix.el'' has been successfully configured, you should be able to
109use a visual interface for routine package management tasks, pretty much
110like the @command{guix package} command (@pxref{Invoking guix package}).
111Specifically, it makes it easy to:
112
113@itemize
114@item browse and display packages and generations;
115@item search, install, upgrade and remove packages;
116@item display packages from previous generations;
117@item do some other useful things.
118@end itemize
119
120@menu
121* Commands: Emacs Commands. @kbd{M-x guix-@dots{}}
122* General information: Emacs General info. Common for both interfaces.
123* ``List'' buffer: Emacs List buffer. List-like interface.
124* ``Info'' buffer: Emacs Info buffer. Help-like interface.
125* Configuration: Emacs Configuration. Configuring the interface.
126@end menu
127
128@node Emacs Commands
129@subsection Commands
130
131All commands for displaying packages and generations use the current
132profile, which can be changed with
133@kbd{M-x@tie{}guix-set-current-profile}. Alternatively, if you call any
134of these commands with prefix argument (@kbd{C-u}), you will be prompted
135for a profile just for that command.
136
137Commands for displaying packages:
138
139@table @kbd
140
141@item M-x guix-all-available-packages
142@itemx M-x guix-newest-available-packages
143Display all/newest available packages.
144
145@item M-x guix-installed-packages
146@itemx M-x guix-installed-user-packages
147@itemx M-x guix-installed-system-packages
148Display installed packages. As described above, @kbd{M-x
149guix-installed-packages} uses an arbitrary profile that you can specify,
150while the other commands display packages installed in 2 special
151profiles: @file{~/.guix-profile} and @file{/run/current-system/profile}
152(only on GuixSD).
153
154@item M-x guix-obsolete-packages
155Display obsolete packages (the packages that are installed in a profile
156but cannot be found among available packages).
157
158@item M-x guix-packages-by-name
159Display package(s) with the specified name.
160
161@item M-x guix-packages-by-license
162Display package(s) with the specified license.
163
164@item M-x guix-packages-by-location
165Display package(s) located in the specified file. These files usually
166have the following form: @file{gnu/packages/emacs.scm}, but don't type
167them manually! Press @key{TAB} to complete the file name.
168
169@item M-x guix-package-from-file
170Display package that the code within the specified file evaluates to.
171@xref{Invoking guix package, @code{--install-from-file}}, for an example
172of what such a file may look like.
173
174@item M-x guix-search-by-regexp
175Search for packages by a specified regexp. By default ``name'',
176``synopsis'' and ``description'' of the packages will be searched. This
177can be changed by modifying @code{guix-package-search-params} variable.
178
179@item M-x guix-search-by-name
180Search for packages with names matching a specified regexp. This
181command is the same as @code{guix-search-by-regexp}, except only a
182package ``name'' is searched.
183
184@end table
185
186By default, these commands display each output on a separate line. If
187you prefer to see a list of packages---i.e., a list with a package per
188line, use the following setting:
189
190@example
191(setq guix-package-list-type 'package)
192@end example
193
194Commands for displaying generations:
195
196@table @kbd
197
198@item M-x guix-generations
199List all the generations.
200
201@item M-x guix-last-generations
202List the @var{N} last generations. You will be prompted for the number
203of generations.
204
205@item M-x guix-generations-by-time
206List generations matching time period. You will be prompted for the
207period using Org mode time prompt based on Emacs calendar (@pxref{The
208date/time prompt,,, org, The Org Manual}).
209
210@end table
211
212Analogously on GuixSD you can also display system generations:
213
214@table @kbd
215@item M-x guix-system-generations
216@item M-x guix-last-system-generations
217@item M-x guix-system-generations-by-time
218@end table
219
220You can also invoke the @command{guix pull} command (@pxref{Invoking
221guix pull}) from Emacs using:
222
223@table @kbd
224@item M-x guix-pull
225With @kbd{C-u}, make it verbose.
226@end table
227
228Once @command{guix pull} has succeeded, the Guix REPL is restarted. This
229allows you to keep using the Emacs interface with the updated Guix.
230
231
232@node Emacs General info
233@subsection General information
234
235The following keys are available for both ``list'' and ``info'' types of
236buffers:
237
238@table @kbd
239@item l
240@itemx r
241Go backward/forward by the history of the displayed results (this
242history is similar to the history of the Emacs @code{help-mode} or
243@code{Info-mode}).
244
245@item g
246Revert current buffer: update information about the displayed
247packages/generations and redisplay it.
248
249@item R
250Redisplay current buffer (without updating information).
251
252@item M
253Apply manifest to the current profile or to a specified profile, if
254prefix argument is used. This has the same meaning as @code{--manifest}
255option (@pxref{Invoking guix package}).
256
257@item C-c C-z
258@cindex REPL
259@cindex read-eval-print loop
260Go to the Guix REPL (@pxref{The REPL,,, geiser, Geiser User Manual}).
261
262@item h
263@itemx ?
264Describe current mode to see all available bindings.
265
266@end table
267
268@emph{Hint:} If you need several ``list'' or ``info'' buffers, you can
269simply @kbd{M-x clone-buffer} them, and each buffer will have its own
270history.
271
272@emph{Warning:} Name/version pairs cannot be used to identify packages
273(because a name is not necessarily unique), so ``guix.el'' uses special
274identifiers that live only during a guile session, so if the Guix REPL
275was restarted, you may want to revert ``list'' buffer (by pressing
276@kbd{g}).
277
278@node Emacs List buffer
279@subsection ``List'' buffer
280
281An interface of a ``list'' buffer is similar to the interface provided
282by ``package.el'' (@pxref{Package Menu,,, emacs, The GNU Emacs Manual}).
283
284Default key bindings available for both ``package-list'' and
285``generation-list'' buffers:
286
287@table @kbd
288@item m
289Mark the current entry (with prefix, mark all entries).
290@item u
291Unmark the current entry (with prefix, unmark all entries).
292@item @key{DEL}
293Unmark backward.
294@item S
295Sort entries by a specified column.
296@end table
297
298A ``package-list'' buffer additionally provides the following bindings:
299
300@table @kbd
301@item @key{RET}
302Describe marked packages (display available information in a
303``package-info'' buffer).
304@item i
305Mark the current package for installation.
306@item d
307Mark the current package for deletion.
308@item U
309Mark the current package for upgrading.
310@item ^
311Mark all obsolete packages for upgrading.
312@item e
313Edit the definition of the current package (go to its location). This is
314similar to @command{guix edit} command (@pxref{Invoking guix edit}), but
315for opening a package recipe in the current Emacs instance.
316@item x
317Execute actions on the marked packages.
318@item B
319Display latest builds of the current package (@pxref{Emacs Hydra}).
320@end table
321
322A ``generation-list'' buffer additionally provides the following
323bindings:
324
325@table @kbd
326@item @key{RET}
327List packages installed in the current generation.
328@item i
329Describe marked generations (display available information in a
330``generation-info'' buffer).
331@item s
332Switch profile to the current generation.
333@item d
334Mark the current generation for deletion (with prefix, mark all
335generations).
336@item x
337Execute actions on the marked generations---i.e., delete generations.
338@item e
339Run Ediff (@pxref{Top,,, ediff, The Ediff Manual}) on package outputs
340installed in the 2 marked generations. With prefix argument, run Ediff
341on manifests of the marked generations.
342@item D
343@itemx =
344Run Diff (@pxref{Diff Mode,,, emacs, The GNU Emacs Manual}) on package
345outputs installed in the 2 marked generations. With prefix argument,
346run Diff on manifests of the marked generations.
347@item +
348List package outputs added to the latest marked generation comparing
349with another marked generation.
350@item -
351List package outputs removed from the latest marked generation comparing
352with another marked generation.
353@end table
354
355@node Emacs Info buffer
356@subsection ``Info'' buffer
357
358The interface of an ``info'' buffer is similar to the interface of
359@code{help-mode} (@pxref{Help Mode,,, emacs, The GNU Emacs Manual}).
360
361``Info'' buffer contains some buttons (as usual you may use @key{TAB} /
362@kbd{S-@key{TAB}} to move between buttons---@pxref{Mouse References,,,
363emacs, The GNU Emacs Manual}) which can be used to:
364
365@itemize @bullet
366@item (in a ``package-info'' buffer)
367
368@itemize @minus
369@item install/remove a package;
370@item jump to a package location;
371@item browse home page of a package;
372@item browse license URL;
373@item describe packages from ``Inputs'' fields.
374@end itemize
375
376@item (in a ``generation-info'' buffer)
377
378@itemize @minus
379@item remove a generation;
380@item switch to a generation;
381@item list packages installed in a generation;
382@item jump to a generation directory.
383@end itemize
384
385@end itemize
386
387It is also possible to copy a button label (a link to an URL or a file)
388by pressing @kbd{c} on a button.
389
390
391@node Emacs Configuration
392@subsection Configuration
393
394There are many variables you can modify to change the appearance or
395behavior of Emacs user interface. Some of these variables are described
396in this section. Also you can use Custom Interface (@pxref{Easy
397Customization,,, emacs, The GNU Emacs Manual}) to explore/set variables
398(not all) and faces.
399
400@menu
401* Guile and Build Options: Emacs Build Options. Specifying how packages are built.
402* Buffer Names: Emacs Buffer Names. Names of Guix buffers.
403* Keymaps: Emacs Keymaps. Configuring key bindings.
404* Appearance: Emacs Appearance. Settings for visual appearance.
405@end menu
406
407@node Emacs Build Options
408@subsubsection Guile and Build Options
409
410@table @code
411@item guix-guile-program
412If you have some special needs for starting a Guile process, you may set
413this variable, for example:
414
415@example
416(setq guix-guile-program '("/bin/guile" "--no-auto-compile"))
417@end example
418
419@item guix-use-substitutes
420If nil, has the same meaning as @code{--no-substitutes} option
421(@pxref{Invoking guix build}).
422
423@item guix-dry-run
424If non-nil, has the same meaning as @code{--dry-run} option
425(@pxref{Invoking guix build}).
426
427@end table
428
429@node Emacs Buffer Names
430@subsubsection Buffer Names
431
432Default names of ``guix.el'' buffers (``*Guix@tie{}@dots{}*'') may be
433changed with the following variables:
434
435@table @code
436@item guix-package-list-buffer-name
437@item guix-output-list-buffer-name
438@item guix-generation-list-buffer-name
439@item guix-package-info-buffer-name
440@item guix-output-info-buffer-name
441@item guix-generation-info-buffer-name
442@item guix-repl-buffer-name
443@item guix-internal-repl-buffer-name
444@end table
445
446By default, the name of a profile is also displayed in a ``list'' or
447``info'' buffer name. To change this behavior, use
448@code{guix-ui-buffer-name-function} variable.
449
450For example, if you want to display all types of results in a single
451buffer (in such case you will probably use a history (@kbd{l}/@kbd{r})
452extensively), you may do it like this:
453
454@example
455(let ((name "Guix Universal"))
456 (setq
457 guix-package-list-buffer-name name
458 guix-output-list-buffer-name name
459 guix-generation-list-buffer-name name
460 guix-package-info-buffer-name name
461 guix-output-info-buffer-name name
462 guix-generation-info-buffer-name name))
463@end example
464
465@node Emacs Keymaps
466@subsubsection Keymaps
467
468If you want to change default key bindings, use the following keymaps
469(@pxref{Init Rebinding,,, emacs, The GNU Emacs Manual}):
470
471@table @code
472@item guix-buffer-map
473Parent keymap with general keys for any buffer type.
474
475@item guix-ui-map
476Parent keymap with general keys for buffers used for Guix package
477management (for packages, outputs and generations).
478
479@item guix-list-mode-map
480Parent keymap with general keys for ``list'' buffers.
481
482@item guix-package-list-mode-map
483Keymap with specific keys for ``package-list'' buffers.
484
485@item guix-output-list-mode-map
486Keymap with specific keys for ``output-list'' buffers.
487
488@item guix-generation-list-mode-map
489Keymap with specific keys for ``generation-list'' buffers.
490
491@item guix-info-mode-map
492Parent keymap with general keys for ``info'' buffers.
493
494@item guix-package-info-mode-map
495Keymap with specific keys for ``package-info'' buffers.
496
497@item guix-output-info-mode-map
498Keymap with specific keys for ``output-info'' buffers.
499
500@item guix-generation-info-mode-map
501Keymap with specific keys for ``generation-info'' buffers.
502
503@item guix-info-button-map
504Keymap with keys available when a point is placed on a button.
505
506@end table
507
508@node Emacs Appearance
509@subsubsection Appearance
510
511You can change almost any aspect of ``list'' / ``info'' buffers using
512the following variables (@dfn{ENTRY-TYPE} means @code{package},
513@code{output} or @code{generation}):
514
515@table @code
516@item guix-ENTRY-TYPE-list-format
517@itemx guix-ENTRY-TYPE-list-titles
518Specify the columns, their names, what and how is displayed in ``list''
519buffers.
520
521@item guix-ENTRY-TYPE-info-format
522@itemx guix-ENTRY-TYPE-info-titles
523@itemx guix-info-ignore-empty-values
524@itemx guix-info-param-title-format
525@itemx guix-info-multiline-prefix
526@itemx guix-info-indent
527@itemx guix-info-fill
528@itemx guix-info-delimiter
529Various settings for ``info'' buffers.
530
531@end table
532
533
534@node Emacs Licenses
535@section Licenses
536
537If you want to browse the URL of a particular license, or to look at a
538list of licenses, you may use the following commands:
539
540@table @kbd
541
542@item M-x guix-browse-license-url
543Choose a license from a completion list to browse its URL using
544@code{browse-url} function (@pxref{Browse-URL,,, emacs, The GNU Emacs
545Manual}).
546
547@item M-x guix-licenses
548Display a list of available licenses. You can press @kbd{@key{RET}}
549there to display packages with this license in the same way as @kbd{M-x
550guix-packages-by-license} would do (@pxref{Emacs Commands}).
551
552@item M-x guix-find-license-definition
553Open @file{@dots{}/guix/licenses.scm} and move to the specified license.
554
555@end table
556
557
558@node Emacs Package Locations
559@section Package Source Locations
560
561As you know, package definitions are placed in Guile files, also known
562as @dfn{package locations}. The following commands should help you not
563get lost in these locations:
564
565@table @kbd
566
567@item M-x guix-locations
568Display a list of package locations. You can press @key{RET} there to
569display packages placed in the current location in the same way as
570@kbd{M-x guix-packages-by-location} would do (@pxref{Emacs Commands}).
571Note that when the point is on a location button, @key{RET} will open
572this location file.
573
574@item M-x guix-find-location
575Open the given package definition source file (press @key{TAB} to choose
576a location from a completion list).
577
578@item M-x guix-edit
579Find location of a specified package. This is an Emacs analog of
580@command{guix edit} command (@pxref{Invoking guix edit}). As with
581@kbd{M-x guix-packages-by-name}, you can press @key{TAB} to complete a
582package name.
583
584@end table
585
586If you are contributing to Guix, you may find it useful for @kbd{M-x
587guix-find-location} and @kbd{M-x guix-edit} to open locations from your
588Git checkout. This can be done by setting @code{guix-directory}
589variable. For example, after this:
590
591@example
592(setq guix-directory "~/src/guix")
593@end example
594
595@kbd{M-x guix-edit guix} opens
596@file{~/src/guix/gnu/packages/package-management.scm} file.
597
598Also you can use @kbd{C-u} prefix argument to specify a directory just
599for the current @kbd{M-x guix-find-location} or @kbd{M-x guix-edit}
600command.
601
602
603@node Emacs Popup Interface
604@section Popup Interface
605
606If you ever used Magit, you know what ``popup interface'' is
607(@pxref{Top,,, magit-popup, Magit-Popup User Manual}). Even if you are
608not acquainted with Magit, there should be no worries as it is very
609intuitive.
610
611So @kbd{M-x@tie{}guix} command provides a top-level popup interface for
612all available guix commands. When you select an option, you'll be
613prompted for a value in the minibuffer. Many values have completions,
614so don't hesitate to press @key{TAB} key. Multiple values (for example,
615packages or lint checkers) should be separated by commas.
616
617After specifying all options and switches for a command, you may choose
618one of the available actions. The following default actions are
619available for all commands:
620
621@itemize
622
623@item
624Run the command in the Guix REPL. It is faster than running
625@code{guix@tie{}@dots{}} command directly in shell, as there is no
626need to run another guile process and to load required modules there.
627
628@item
629Run the command in a shell buffer. You can set
630@code{guix-run-in-shell-function} variable to fine tune the shell buffer
631you want to use.
632
633@item
634Add the command line to the kill ring (@pxref{Kill Ring,,, emacs, The
635GNU Emacs Manual}).
636
637@end itemize
638
639Several commands (@command{guix graph}, @command{guix system shepherd-graph}
640and @command{guix system extension-graph}) also have a ``View graph''
641action, which allows you to view a generated graph using @command{dot}
642command (specified by @code{guix-dot-program} variable). By default a
643PNG file will be saved in @file{/tmp} directory and will be opened
644directly in Emacs. This behavior may be changed with the following
645variables:
646
647@table @code
648
649@item guix-find-file-function
650Function used to open a generated graph. If you want to open a graph in
651an external program, you can do it by modifying this variable---for
652example, you can use a functionality provided by the Org Mode
653(@pxref{Top,,, org, The Org Manual}):
654
655@example
656(setq guix-find-file-function 'org-open-file)
657(add-to-list 'org-file-apps '("\\.png\\'" . "sxiv %s"))
658@end example
659
660@item guix-dot-default-arguments
661Command line arguments to run @command{dot} command. If you change an
662output format (for example, into @code{-Tpdf}), you also need to change
663the next variable.
664
665@item guix-dot-file-name-function
666Function used to define a name of the generated graph file. Default
667name is @file{/tmp/guix-emacs-graph-XXXXXX.png}.
668
669@end table
670
671So, for example, if you want to generate and open a PDF file in your
672Emacs, you may change the settings like this:
673
674@example
675(defun my-guix-pdf-graph ()
676 "/tmp/my-current-guix-graph.pdf")
677
678(setq guix-dot-default-arguments '("-Tpdf")
679 guix-dot-file-name-function 'my-guix-pdf-graph)
680@end example
681
682
683@node Emacs Prettify
684@section Guix Prettify Mode
685
686GNU@tie{}Guix also comes with ``guix-prettify.el''. It provides a minor
687mode for abbreviating store file names by replacing hash sequences of
688symbols with ``@dots{}'':
689
690@example
691/gnu/store/72f54nfp6g1hz873w8z3gfcah0h4nl9p-foo-0.1
692@result{} /gnu/store/…-foo-0.1
693@end example
694
695Once you set up ``guix.el'' (@pxref{Emacs Initial Setup}), the following
696commands become available:
697
698@table @kbd
699
700@item M-x guix-prettify-mode
701Enable/disable prettifying for the current buffer.
702
703@item M-x global-guix-prettify-mode
704Enable/disable prettifying globally.
705
706@end table
707
708To automatically enable @code{guix-prettify-mode} globally on Emacs
709start, add the following line to your init file:
710
711@example
712(global-guix-prettify-mode)
713@end example
714
715If you want to enable it only for specific major modes, add it to the
716mode hooks (@pxref{Hooks,,, emacs, The GNU Emacs Manual}), for example:
717
718@example
719(add-hook 'shell-mode-hook 'guix-prettify-mode)
720(add-hook 'dired-mode-hook 'guix-prettify-mode)
721@end example
722
723
724@node Emacs Build Log
725@section Build Log Mode
726
727GNU@tie{}Guix provides major and minor modes for highlighting build
728logs. So when you have a file with a package build output---for
729example, a file returned by @command{guix build --log-file @dots{}}
730command (@pxref{Invoking guix build}), you may call @kbd{M-x
731guix-build-log-mode} command in the buffer with this file. This major
732mode highlights some lines specific to build output and provides the
733following key bindings:
734
735@table @kbd
736
737@item M-n
738Move to the next build phase.
739
740@item M-p
741Move to the previous build phase.
742
743@item @key{TAB}
744Toggle (show/hide) the body of the current build phase.
745
746@item S-@key{TAB}
747Toggle (show/hide) the bodies of all build phases.
748
749@end table
750
751There is also @kbd{M-x guix-build-log-minor-mode} which also provides
752the same highlighting and the same key bindings as the major mode, but
753prefixed with @kbd{C-c}. By default, this minor mode is enabled in
754shell buffers (@pxref{Interactive Shell,,, emacs, The GNU Emacs
755Manual}). If you don't like it, set
756@code{guix-build-log-minor-mode-activate} to nil.
757
758
759@node Emacs Completions
760@section Shell Completions
761
762Another feature that becomes available after configuring Emacs interface
763(@pxref{Emacs Initial Setup}) is completing of @command{guix}
764subcommands, options, packages and other things in @code{shell}
765(@pxref{Interactive Shell,,, emacs, The GNU Emacs Manual}) and
766@code{eshell} (@pxref{Top,,, eshell, Eshell: The Emacs Shell}).
767
768It works the same way as other completions do. Just press @key{TAB}
769when your intuition tells you.
770
771And here are some examples, where pressing @key{TAB} may complete
772something:
773
774@itemize @w{}
775
776@item @code{guix pa}@key{TAB}
777@item @code{guix package -}@key{TAB}
778@item @code{guix package --}@key{TAB}
779@item @code{guix package -i gei}@key{TAB}
780@item @code{guix build -L/tm}@key{TAB}
781@item @code{guix build --sy}@key{TAB}
782@item @code{guix build --system=i}@key{TAB}
783@item @code{guix system rec}@key{TAB}
784@item @code{guix lint --checkers=sy}@key{TAB}
785@item @code{guix lint --checkers=synopsis,des}@key{TAB}
786
787@end itemize
788
789
790@node Emacs Development
791@section Development
792
793By default, when you open a Scheme file, @code{guix-devel-mode} will be
794activated (if you don't want it, set @code{guix-devel-activate-mode} to
795nil). This minor mode provides the following key bindings:
796
797@table @kbd
798
799@item C-c . k
800Copy the name of the current Guile module into kill ring
801(@code{guix-devel-copy-module-as-kill}).
802
803@item C-c . u
804Use the current Guile module. Often after opening a Scheme file, you
805want to use a module it defines, so you switch to the Geiser REPL and
806write @code{,use (some module)} there. You may just use this command
807instead (@code{guix-devel-use-module}).
808
809@item C-c . b
810Build a package defined by the current variable definition. The
811building process is run in the current Geiser REPL. If you modified the
812current package definition, don't forget to reevaluate it before calling
813this command---for example, with @kbd{C-M-x} (@pxref{To eval or not to
814eval,,, geiser, Geiser User Manual})
815(@code{guix-devel-build-package-definition}).
816
817@item C-c . s
818Build a source derivation of the package defined by the current variable
819definition. This command has the same meaning as @code{guix build -S}
820shell command (@pxref{Invoking guix build})
821(@code{guix-devel-build-package-source}).
822
823@item C-c . l
824Lint (check) a package defined by the current variable definition
825(@pxref{Invoking guix lint}) (@code{guix-devel-lint-package}).
826
827@end table
828
829Unluckily, there is a limitation related to long-running REPL commands.
830When there is a running process in a Geiser REPL, you are not supposed
831to evaluate anything in a scheme buffer, because this will ``freeze''
832the REPL: it will stop producing any output (however, the evaluating
833process will continue---you will just not see any progress anymore). Be
834aware: even moving the point in a scheme buffer may ``break'' the REPL
835if Autodoc (@pxref{Autodoc and friends,,, geiser, Geiser User Manual})
836is enabled (which is the default).
837
838So you have to postpone editing your scheme buffers until the running
839evaluation will be finished in the REPL.
840
841Alternatively, to avoid this limitation, you may just run another Geiser
842REPL, and while something is being evaluated in the previous REPL, you
843can continue editing a scheme file with the help of the current one.
844
845
846@node Emacs Hydra
847@section Hydra
848
849The continuous integration server at @code{hydra.gnu.org} builds all
850the distribution packages on the supported architectures and serves
851them as substitutes (@pxref{Substitutes}). Continuous integration is
852currently orchestrated by @uref{https://nixos.org/hydra/, Hydra}.
853
854This section describes an Emacs interface to query Hydra to know the
855build status of specific packages, discover recent and ongoing builds,
856view build logs, and so on. This interface is mostly the same as the
857``list''/``info'' interface for displaying packages and generations
858(@pxref{Emacs Package Management}).
859
860The following commands are available:
861
862@table @kbd
863
864@item M-x guix-hydra-latest-builds
865Display latest failed or successful builds (you will be prompted for a
866number of builds). With @kbd{C-u}, you will also be prompted for other
867parameters (project, jobset, job and system).
868
869@item M-x guix-hydra-queued-builds
870Display scheduled or currently running builds (you will be prompted for
871a number of builds).
872
873@item M-x guix-hydra-jobsets
874Display available jobsets (you will be prompted for a project).
875
876@end table
877
878In a list of builds you can press @kbd{L} key to display a build log of
879the current build. Also both a list of builds and a list of jobsets
880provide @kbd{B} key to display latest builds of the current job or
881jobset (don't forget about @kbd{C-u}).
diff --git a/doc/guix.texi b/doc/guix.texi
index 69129d5835e..8756061a46e 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -54,12 +54,6 @@ Documentation License''.
54* guix environment: (guix)Invoking guix environment. Building development environments with Guix. 54* guix environment: (guix)Invoking guix environment. Building development environments with Guix.
55@end direntry 55@end direntry
56 56
57@dircategory Emacs
58@direntry
59* Guix user interface: (guix)Emacs Interface. Package management from the comfort of Emacs.
60@end direntry
61
62
63@titlepage 57@titlepage
64@title GNU Guix Reference Manual 58@title GNU Guix Reference Manual
65@subtitle Using the GNU Guix Functional Package Manager 59@subtitle Using the GNU Guix Functional Package Manager
@@ -86,7 +80,6 @@ package management tool written for the GNU system.
86* Introduction:: What is Guix about? 80* Introduction:: What is Guix about?
87* Installation:: Installing Guix. 81* Installation:: Installing Guix.
88* Package Management:: Package installation, upgrade, etc. 82* Package Management:: Package installation, upgrade, etc.
89* Emacs Interface:: Using Guix from Emacs.
90* Programming Interface:: Using Guix in Scheme. 83* Programming Interface:: Using Guix in Scheme.
91* Utilities:: Package management commands. 84* Utilities:: Package management commands.
92* GNU Distribution:: Software for your friendly GNU system. 85* GNU Distribution:: Software for your friendly GNU system.
@@ -124,19 +117,6 @@ Package Management
124* Invoking guix pull:: Fetching the latest Guix and distribution. 117* Invoking guix pull:: Fetching the latest Guix and distribution.
125* Invoking guix archive:: Exporting and importing store files. 118* Invoking guix archive:: Exporting and importing store files.
126 119
127Emacs Interface
128
129* Initial Setup: Emacs Initial Setup. Preparing @file{~/.emacs}.
130* Package Management: Emacs Package Management. Managing packages and generations.
131* Licenses: Emacs Licenses. Interface for licenses of Guix packages.
132* Package Source Locations: Emacs Package Locations. Interface for package location files.
133* Popup Interface: Emacs Popup Interface. Magit-like interface for guix commands.
134* Prettify Mode: Emacs Prettify. Abbreviating @file{/gnu/store/@dots{}} file names.
135* Build Log Mode: Emacs Build Log. Highlighting Guix build logs.
136* Completions: Emacs Completions. Completing @command{guix} shell command.
137* Development: Emacs Development. Tools for Guix developers.
138* Hydra: Emacs Hydra. Interface for Guix build farm.
139
140Programming Interface 120Programming Interface
141 121
142* Defining Packages:: Defining new packages. 122* Defining Packages:: Defining new packages.
@@ -278,8 +258,7 @@ assists with the creation and maintenance of software environments.
278@cindex user interfaces 258@cindex user interfaces
279Guix provides a command-line package management interface 259Guix provides a command-line package management interface
280(@pxref{Invoking guix package}), a set of command-line utilities 260(@pxref{Invoking guix package}), a set of command-line utilities
281(@pxref{Utilities}), a visual user interface in Emacs (@pxref{Emacs 261(@pxref{Utilities}), as well as Scheme programming interfaces
282Interface}), as well as Scheme programming interfaces
283(@pxref{Programming Interface}). 262(@pxref{Programming Interface}).
284@cindex build daemon 263@cindex build daemon
285Its @dfn{build daemon} is responsible for building packages on behalf of 264Its @dfn{build daemon} is responsible for building packages on behalf of
@@ -1414,10 +1393,14 @@ procedures or dependencies. Guix also goes beyond this obvious set of
1414features. 1393features.
1415 1394
1416This chapter describes the main features of Guix, as well as the package 1395This chapter describes the main features of Guix, as well as the package
1417management tools it provides. Two user interfaces are provided for 1396management tools it provides. Along with the command-line interface
1418routine package management tasks: A command-line interface described below 1397described below (@pxref{Invoking guix package, @code{guix package}}),
1419(@pxref{Invoking guix package, @code{guix package}}), as well as a visual user 1398you may also use Emacs Interface, after installing @code{emacs-guix}
1420interface in Emacs described in a subsequent chapter (@pxref{Emacs Interface}). 1399package (run @kbd{M-x guix-help} command to start with it):
1400
1401@example
1402guix package -i emacs-guix
1403@end example
1421 1404
1422@menu 1405@menu
1423* Features:: How Guix will make your life brighter. 1406* Features:: How Guix will make your life brighter.
@@ -1434,9 +1417,7 @@ interface in Emacs described in a subsequent chapter (@pxref{Emacs Interface}).
1434 1417
1435When using Guix, each package ends up in the @dfn{package store}, in its 1418When using Guix, each package ends up in the @dfn{package store}, in its
1436own directory---something that resembles 1419own directory---something that resembles
1437@file{/gnu/store/xxx-package-1.2}, where @code{xxx} is a base32 string 1420@file{/gnu/store/xxx-package-1.2}, where @code{xxx} is a base32 string.
1438(note that Guix comes with an Emacs extension to shorten those file
1439names, @pxref{Emacs Prettify}.)
1440 1421
1441Instead of referring to these directories, users have their own 1422Instead of referring to these directories, users have their own
1442@dfn{profile}, which points to the packages that they actually want to 1423@dfn{profile}, which points to the packages that they actually want to
@@ -1982,9 +1963,7 @@ also result from derivation builds, can be available as substitutes.
1982 1963
1983The @code{hydra.gnu.org} server is a front-end to a build farm that 1964The @code{hydra.gnu.org} server is a front-end to a build farm that
1984builds packages from the GNU distribution continuously for some 1965builds packages from the GNU distribution continuously for some
1985architectures, and makes them available as substitutes (@pxref{Emacs 1966architectures, and makes them available as substitutes. This is the
1986Hydra}, for information on how to query the continuous integration
1987server). This is the
1988default source of substitutes; it can be overridden by passing the 1967default source of substitutes; it can be overridden by passing the
1989@option{--substitute-urls} option either to @command{guix-daemon} 1968@option{--substitute-urls} option either to @command{guix-daemon}
1990(@pxref{daemon-substitute-urls,, @code{guix-daemon --substitute-urls}}) 1969(@pxref{daemon-substitute-urls,, @code{guix-daemon --substitute-urls}})
@@ -2510,9 +2489,6 @@ archive contents coming from possibly untrusted substitute servers.
2510@end table 2489@end table
2511 2490
2512@c ********************************************************************* 2491@c *********************************************************************
2513@include emacs.texi
2514
2515@c *********************************************************************
2516@node Programming Interface 2492@node Programming Interface
2517@chapter Programming Interface 2493@chapter Programming Interface
2518 2494
@@ -4923,11 +4899,6 @@ have created your own packages on @code{GUIX_PACKAGE_PATH}
4923recipes. Otherwise, you will be able to examine the read-only recipes 4899recipes. Otherwise, you will be able to examine the read-only recipes
4924for packages currently in the store. 4900for packages currently in the store.
4925 4901
4926If you are using Emacs, note that the Emacs user interface provides the
4927@kbd{M-x guix-edit} command and a similar functionality in the ``package
4928info'' and ``package list'' buffers created by the @kbd{M-x
4929guix-search-by-name} and similar commands (@pxref{Emacs Commands}).
4930
4931 4902
4932@node Invoking guix download 4903@node Invoking guix download
4933@section Invoking @command{guix download} 4904@section Invoking @command{guix download}
diff --git a/doc/htmlxref.cnf b/doc/htmlxref.cnf
index bd2eb5f1477..93e214fcc56 100644
--- a/doc/htmlxref.cnf
+++ b/doc/htmlxref.cnf
@@ -219,6 +219,8 @@ emacs node ${EMACS}/html_node/emacs/
219easejs mono ${GS}/easejs/manual/easejs.html 219easejs mono ${GS}/easejs/manual/easejs.html
220easejs node ${GS}/easejs/manual/ 220easejs node ${GS}/easejs/manual/
221 221
222emacs-guix mono https://notabug.org/alezost/emacs-guix
223
222emacs-muse node ${GS}/emacs-muse/manual/muse.html 224emacs-muse node ${GS}/emacs-muse/manual/muse.html
223emacs-muse node ${GS}/emacs-muse/manual/html_node/ 225emacs-muse node ${GS}/emacs-muse/manual/html_node/
224 226
diff --git a/emacs/guix-about.el b/emacs/guix-about.el
deleted file mode 100644
index 27a79fe1626..00000000000
--- a/emacs/guix-about.el
+++ /dev/null
@@ -1,37 +0,0 @@
1;;; guix-about.el --- Various info about Guix
2
3;; Copyright © 2016 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 Location as published by
9;; the Free Software Foundation, either version 3 of the Location, 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 Location for more details.
16
17;; You should have received a copy of the GNU General Public Location
18;; along with this program. If not, see <http://www.gnu.org/locations/>.
19
20;;; Commentary:
21
22;; This file provides the code to display various info about Guix (e.g., its
23;; version).
24
25;;; Code:
26
27(require 'guix-config)
28
29;;;###autoload
30(defun guix-version ()
31 "Display Guix version in the echo area."
32 (interactive)
33 (message "%s %s" guix-config-name guix-config-version))
34
35(provide 'guix-about)
36
37;;; guix-about.el ends here
diff --git a/emacs/guix-backend.el b/emacs/guix-backend.el
deleted file mode 100644
index 6341aacae10..00000000000
--- a/emacs/guix-backend.el
+++ /dev/null
@@ -1,393 +0,0 @@
1;;; guix-backend.el --- Making and using Guix REPL
2
3;; Copyright © 2014, 2015, 2016 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 Guix REPL
23;; (Geiser REPL with some guix-specific additions).
24
25;; By default (if `guix-use-guile-server' is non-nil) 2 Guix REPLs are
26;; started. The main one (with "guile --listen" process) is used for
27;; "interacting" with a user - for showing a progress of
28;; installing/deleting Guix packages. The second (internal) REPL is
29;; used for synchronous evaluating, e.g. when information about
30;; packages/generations should be received for a list/info buffer.
31;;
32;; This "2 REPLs concept" makes it possible to have a running process of
33;; installing/deleting packages and to continue to search/list/get info
34;; about other packages at the same time. If you prefer to use a single
35;; Guix REPL, do not try to receive any information while there is a
36;; running code in the REPL (see
37;; <https://github.com/jaor/geiser/issues/28>).
38;;
39;; Guix REPLs (unlike the usual Geiser REPLs) are not added to
40;; `geiser-repl--repls' variable, and thus cannot be used for evaluating
41;; while editing scm-files. The only purpose of Guix REPLs is to be an
42;; intermediate between "Guix/Guile level" and "Emacs interface level".
43;; That being said you can still want to use a Guix REPL while hacking
44;; auxiliary scheme-files for "guix.el". You can just use
45;; `geiser-connect-local' command with `guix-repl-current-socket' to
46;; have a usual Geiser REPL with all stuff defined by "guix.el" package.
47
48;;; Code:
49
50(require 'geiser-mode)
51(require 'geiser-guile)
52(require 'guix-geiser)
53(require 'guix-config)
54(require 'guix-external)
55(require 'guix-emacs)
56(require 'guix-profiles)
57
58(defvar guix-load-path guix-config-emacs-interface-directory
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
66;;; REPL
67
68(defgroup guix-repl nil
69 "Settings for Guix REPLs."
70 :prefix "guix-repl-"
71 :group 'guix)
72
73(defcustom guix-repl-startup-time 30000
74 "Time, in milliseconds, to wait for Guix REPL to startup.
75Same as `geiser-repl-startup-time' but is used for Guix REPL.
76If you have a slow system, try to increase this time."
77 :type 'integer
78 :group 'guix-repl)
79
80(defcustom guix-repl-buffer-name "*Guix REPL*"
81 "Default name of a Geiser REPL buffer used for Guix."
82 :type 'string
83 :group 'guix-repl)
84
85(defcustom guix-after-start-repl-hook '(guix-set-directory)
86 "Hook called after Guix REPL is started."
87 :type 'hook
88 :group 'guix-repl)
89
90(defcustom guix-use-guile-server t
91 "If non-nil, start guile with '--listen' argument.
92This allows to receive information about packages using an additional
93REPL while some packages are being installed/removed in the main REPL."
94 :type 'boolean
95 :group 'guix-repl)
96
97(defcustom guix-repl-socket-file-name-function
98 #'guix-repl-socket-file-name
99 "Function used to define a socket file name used by Guix REPL.
100The function is called without arguments."
101 :type '(choice (function-item guix-repl-socket-file-name)
102 (function :tag "Other function"))
103 :group 'guix-repl)
104
105(defcustom guix-emacs-activate-after-operation t
106 "Activate Emacs packages after installing.
107If nil, do not load autoloads of the Emacs packages after
108they are successfully installed."
109 :type 'boolean
110 :group 'guix-repl)
111
112(defvar guix-repl-current-socket nil
113 "Name of a socket file used by the current Guix REPL.")
114
115(defvar guix-repl-buffer nil
116 "Main Geiser REPL buffer used for communicating with Guix.
117This REPL is used for processing package actions and for
118receiving information if `guix-use-guile-server' is nil.")
119
120(defvar guix-internal-repl-buffer nil
121 "Additional Geiser REPL buffer used for communicating with Guix.
122This REPL is used for receiving information only if
123`guix-use-guile-server' is non-nil.")
124
125(defvar guix-internal-repl-buffer-name "*Guix Internal REPL*"
126 "Default name of an internal Guix REPL buffer.")
127
128(defvar guix-before-repl-operation-hook nil
129 "Hook run before executing an operation in Guix REPL.")
130
131(defvar guix-after-repl-operation-hook
132 '(guix-repl-autoload-emacs-packages-maybe
133 guix-repl-operation-success-message)
134 "Hook run after executing successful operation in Guix REPL.")
135
136(defvar guix-repl-operation-p nil
137 "Non-nil, if current operation is performed by `guix-eval-in-repl'.
138This internal variable is used to distinguish Guix operations
139from operations performed in Guix REPL by a user.")
140
141(defvar guix-repl-operation-type nil
142 "Type of the current operation performed by `guix-eval-in-repl'.
143This internal variable is used to define what actions should be
144executed after the current operation succeeds.
145See `guix-eval-in-repl' for details.")
146
147(defun guix-repl-autoload-emacs-packages-maybe ()
148 "Load autoloads for Emacs packages if needed.
149See `guix-emacs-activate-after-operation' for details."
150 (and guix-emacs-activate-after-operation
151 ;; FIXME Since a user can work with a non-current profile (using
152 ;; C-u before `guix-search-by-name' and other commands), emacs
153 ;; packages can be installed to another profile, and the
154 ;; following code will not work (i.e., the autoloads for this
155 ;; profile will not be loaded).
156 (guix-emacs-autoload-packages guix-current-profile)))
157
158(defun guix-repl-operation-success-message ()
159 "Message telling about successful Guix operation."
160 (message "Guix operation has been performed."))
161
162(defun guix-get-guile-program (&optional socket)
163 "Return a value suitable for `geiser-guile-binary'."
164 (if (null socket)
165 guix-guile-program
166 (append (if (listp guix-guile-program)
167 guix-guile-program
168 (list guix-guile-program))
169 (list (concat "--listen=" socket)))))
170
171(defun guix-repl-socket-file-name ()
172 "Return a name of a socket file used by Guix REPL."
173 (make-temp-name
174 (concat (file-name-as-directory temporary-file-directory)
175 "guix-repl-")))
176
177(defun guix-repl-delete-socket-maybe ()
178 "Delete `guix-repl-current-socket' file if it exists."
179 (and guix-repl-current-socket
180 (file-exists-p guix-repl-current-socket)
181 (delete-file guix-repl-current-socket)))
182
183(add-hook 'kill-emacs-hook 'guix-repl-delete-socket-maybe)
184
185(defun guix-start-process-maybe (&optional start-msg end-msg)
186 "Start Geiser REPL configured for Guix if needed.
187START-MSG and END-MSG are strings displayed in the minibuffer in
188the beginning and in the end of the starting process. If nil,
189display default messages."
190 (guix-start-repl-maybe nil
191 (or start-msg "Starting Guix REPL ...")
192 (or end-msg "Guix REPL has been started."))
193 (if guix-use-guile-server
194 (guix-start-repl-maybe 'internal)
195 (setq guix-internal-repl-buffer guix-repl-buffer)))
196
197(defun guix-start-repl-maybe (&optional internal start-msg end-msg)
198 "Start Guix REPL if needed.
199If INTERNAL is non-nil, start an internal REPL.
200
201START-MSG and END-MSG are strings displayed in the minibuffer in
202the beginning and in the end of the process. If nil, do not
203display messages."
204 (let* ((repl-var (guix-get-repl-buffer-variable internal))
205 (repl (symbol-value repl-var)))
206 (unless (and (buffer-live-p repl)
207 (get-buffer-process repl))
208 (and start-msg (message start-msg))
209 (setq guix-repl-operation-p nil)
210 (unless internal
211 ;; Guile leaves socket file after exit, so remove it if it
212 ;; exists (after the REPL restart).
213 (guix-repl-delete-socket-maybe)
214 (setq guix-repl-current-socket
215 (and guix-use-guile-server
216 (or guix-repl-current-socket
217 (funcall guix-repl-socket-file-name-function)))))
218 (let ((geiser-guile-binary (guix-get-guile-program
219 (unless internal
220 guix-repl-current-socket)))
221 (geiser-guile-init-file (unless internal guix-helper-file))
222 (repl (get-buffer-create
223 (guix-get-repl-buffer-name internal))))
224 (guix-start-repl repl (and internal guix-repl-current-socket))
225 (set repl-var repl)
226 (and end-msg (message end-msg))
227 (unless internal
228 (run-hooks 'guix-after-start-repl-hook))))))
229
230(defun guix-start-repl (buffer &optional address)
231 "Start Guix REPL in BUFFER.
232If ADDRESS is non-nil, connect to a remote guile process using
233this address (it should be defined by
234`geiser-repl--read-address')."
235 ;; A mix of the code from `geiser-repl--start-repl' and
236 ;; `geiser-repl--to-repl-buffer'.
237 (let ((impl 'guile)
238 (geiser-guile-load-path (cons (expand-file-name guix-load-path)
239 geiser-guile-load-path))
240 (geiser-repl-startup-time guix-repl-startup-time))
241 (with-current-buffer buffer
242 (geiser-repl-mode)
243 (geiser-impl--set-buffer-implementation impl)
244 (geiser-repl--autodoc-mode -1)
245 (goto-char (point-max))
246 (let ((prompt (geiser-con--combined-prompt
247 geiser-guile--prompt-regexp
248 geiser-guile--debugger-prompt-regexp)))
249 (geiser-repl--save-remote-data address)
250 (geiser-repl--start-scheme impl address prompt)
251 (geiser-repl--quit-setup)
252 (geiser-repl--history-setup)
253 (setq-local geiser-repl--repls (list buffer))
254 (geiser-repl--set-this-buffer-repl buffer)
255 (setq geiser-repl--connection
256 (geiser-con--make-connection
257 (get-buffer-process (current-buffer))
258 geiser-guile--prompt-regexp
259 geiser-guile--debugger-prompt-regexp))
260 (geiser-repl--startup impl address)
261 (geiser-repl--autodoc-mode 1)
262 (geiser-company--setup geiser-repl-company-p)
263 (add-hook 'comint-output-filter-functions
264 'guix-repl-output-filter
265 nil t)
266 (set-process-query-on-exit-flag
267 (get-buffer-process (current-buffer))
268 geiser-repl-query-on-kill-p)))))
269
270(defun guix-repl-output-filter (str)
271 "Filter function suitable for `comint-output-filter-functions'.
272This is a replacement for `geiser-repl--output-filter'."
273 (cond
274 ((string-match-p geiser-guile--prompt-regexp str)
275 (geiser-autodoc--disinhibit-autodoc)
276 (when guix-repl-operation-p
277 (setq guix-repl-operation-p nil)
278 (run-hooks 'guix-after-repl-operation-hook)
279 ;; Run hooks specific to the current operation type.
280 (when guix-repl-operation-type
281 (let ((type-hook (intern
282 (concat "guix-after-"
283 (symbol-name guix-repl-operation-type)
284 "-hook"))))
285 (setq guix-repl-operation-type nil)
286 (and (boundp type-hook)
287 (run-hooks type-hook))))))
288 ((string-match geiser-guile--debugger-prompt-regexp str)
289 (setq guix-repl-operation-p nil)
290 (geiser-con--connection-set-debugging geiser-repl--connection
291 (match-beginning 0))
292 (geiser-autodoc--disinhibit-autodoc))))
293
294(defun guix-repl-exit (&optional internal no-wait)
295 "Exit the current Guix REPL.
296If INTERNAL is non-nil, exit the internal REPL.
297If NO-WAIT is non-nil, do not wait for the REPL process to exit:
298send a kill signal to it and return immediately."
299 (let ((repl (symbol-value (guix-get-repl-buffer-variable internal))))
300 (when (get-buffer-process repl)
301 (with-current-buffer repl
302 (geiser-con--connection-deactivate geiser-repl--connection t)
303 (comint-kill-subjob)
304 (unless no-wait
305 (while (get-buffer-process repl)
306 (sleep-for 0.1)))))))
307
308(defun guix-get-repl-buffer (&optional internal)
309 "Return Guix REPL buffer; start REPL if needed.
310If INTERNAL is non-nil, return an additional internal REPL."
311 (guix-start-process-maybe)
312 (let ((repl (symbol-value (guix-get-repl-buffer-variable internal))))
313 ;; If a new Geiser REPL is started, `geiser-repl--repl' variable may
314 ;; be set to the new value in a Guix REPL, so set it back to a
315 ;; proper value here.
316 (with-current-buffer repl
317 (geiser-repl--set-this-buffer-repl repl))
318 repl))
319
320(defun guix-get-repl-buffer-variable (&optional internal)
321 "Return the name of a variable with a REPL buffer."
322 (if internal
323 'guix-internal-repl-buffer
324 'guix-repl-buffer))
325
326(defun guix-get-repl-buffer-name (&optional internal)
327 "Return the name of a REPL buffer."
328 (if internal
329 guix-internal-repl-buffer-name
330 guix-repl-buffer-name))
331
332(defun guix-switch-to-repl (&optional internal)
333 "Switch to Guix REPL.
334If INTERNAL is non-nil (interactively with prefix), switch to the
335additional internal REPL if it exists."
336 (interactive "P")
337 (geiser-repl--switch-to-buffer (guix-get-repl-buffer internal)))
338
339
340;;; Guix directory
341
342(defvar guix-directory nil
343 "Default directory with Guix source.
344If it is not set by a user, it is set after starting Guile REPL.
345This directory is used to define package locations.")
346
347(defun guix-read-directory ()
348 "Return `guix-directory' or prompt for it.
349This function is intended for using in `interactive' forms."
350 (if current-prefix-arg
351 (read-directory-name "Directory with Guix modules: "
352 guix-directory)
353 guix-directory))
354
355(defun guix-set-directory ()
356 "Set `guix-directory' if needed."
357 (or guix-directory
358 (setq guix-directory
359 (guix-eval-read "%guix-dir"))))
360
361
362;;; Evaluating expressions
363
364(defvar guix-operation-buffer nil
365 "Buffer from which the latest Guix operation was performed.")
366
367(defun guix-eval (str)
368 "Evaluate STR with guile expression using Guix REPL.
369See `guix-geiser-eval' for details."
370 (guix-geiser-eval str (guix-get-repl-buffer 'internal)))
371
372(defun guix-eval-read (str)
373 "Evaluate STR with guile expression using Guix REPL.
374See `guix-geiser-eval-read' for details."
375 (guix-geiser-eval-read str (guix-get-repl-buffer 'internal)))
376
377(defun guix-eval-in-repl (str &optional operation-buffer operation-type)
378 "Switch to Guix REPL and evaluate STR with guile expression there.
379If OPERATION-BUFFER is non-nil, it should be a buffer from which
380the current operation was performed.
381
382If OPERATION-TYPE is non-nil, it should be a symbol. After
383successful executing of the current operation,
384`guix-after-OPERATION-TYPE-hook' is called."
385 (run-hooks 'guix-before-repl-operation-hook)
386 (setq guix-repl-operation-p t
387 guix-repl-operation-type operation-type
388 guix-operation-buffer operation-buffer)
389 (guix-geiser-eval-in-repl str (guix-get-repl-buffer)))
390
391(provide 'guix-backend)
392
393;;; guix-backend.el ends here
diff --git a/emacs/guix-base.el b/emacs/guix-base.el
deleted file mode 100644
index 658cfdb5fa5..00000000000
--- a/emacs/guix-base.el
+++ /dev/null
@@ -1,377 +0,0 @@
1;;; guix-base.el --- Common definitions -*- lexical-binding: t -*-
2
3;; Copyright © 2014, 2015, 2016 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;;; Code:
26
27(require 'cl-lib)
28(require 'guix-backend)
29(require 'guix-guile)
30(require 'guix-read)
31(require 'guix-utils)
32(require 'guix-ui)
33(require 'guix-profiles)
34
35(defgroup guix nil
36 "Settings for Guix package manager and friends."
37 :prefix "guix-"
38 :group 'external)
39
40(defgroup guix-faces nil
41 "Guix faces."
42 :group 'guix
43 :group 'faces)
44
45(defun guix-package-name-specification (name version &optional output)
46 "Return Guix package specification by its NAME, VERSION and OUTPUT."
47 (concat name "@" version
48 (when output (concat ":" output))))
49
50
51;;; Location of profiles and manifests
52
53(defun guix-generation-file (profile generation)
54 "Return the file name of a PROFILE's GENERATION."
55 (format "%s-%s-link" profile generation))
56
57(defun guix-packages-profile (profile &optional generation system?)
58 "Return a directory where packages are installed for the
59PROFILE's GENERATION.
60
61If SYSTEM? is non-nil, then PROFILE is considered to be a system
62profile. Unlike usual profiles, for a system profile, packages
63are placed in 'profile' subdirectory."
64 (let ((profile (if generation
65 (guix-generation-file profile generation)
66 profile)))
67 (if system?
68 (expand-file-name "profile" profile)
69 profile)))
70
71(defun guix-manifest-file (profile &optional generation system?)
72 "Return the file name of a PROFILE's manifest.
73See `guix-packages-profile'."
74 (expand-file-name "manifest"
75 (guix-packages-profile profile generation system?)))
76
77
78;;; Actions on packages and generations
79
80(defface guix-operation-option-key
81 '((t :inherit font-lock-warning-face))
82 "Face used for the keys of operation options."
83 :group 'guix-faces)
84
85(defcustom guix-operation-confirm t
86 "If nil, do not prompt to confirm an operation."
87 :type 'boolean
88 :group 'guix)
89
90(defcustom guix-use-substitutes t
91 "If non-nil, use substitutes for the Guix packages."
92 :type 'boolean
93 :group 'guix)
94
95(defvar guix-dry-run nil
96 "If non-nil, do not perform the real actions, just simulate.")
97
98(defvar guix-temp-buffer-name " *Guix temp*"
99 "Name of a buffer used for displaying info before executing operation.")
100
101(defvar guix-operation-option-true-string "yes"
102 "String displayed in the mode-line when operation option is t.")
103
104(defvar guix-operation-option-false-string "no "
105 "String displayed in the mode-line when operation option is nil.")
106
107(defvar guix-operation-option-separator " | "
108 "String used in the mode-line to separate operation options.")
109
110(defvar guix-operation-options
111 '((?s "substitutes" guix-use-substitutes)
112 (?d "dry-run" guix-dry-run))
113 "List of available operation options.
114Each element of the list has a form:
115
116 (KEY NAME VARIABLE)
117
118KEY is a character that may be pressed during confirmation to
119toggle the option.
120NAME is a string displayed in the mode-line.
121VARIABLE is a name of an option variable.")
122
123(defun guix-operation-option-by-key (key)
124 "Return operation option by KEY (character)."
125 (assq key guix-operation-options))
126
127(defun guix-operation-option-key (option)
128 "Return key (character) of the operation OPTION."
129 (car option))
130
131(defun guix-operation-option-name (option)
132 "Return name of the operation OPTION."
133 (nth 1 option))
134
135(defun guix-operation-option-variable (option)
136 "Return name of the variable of the operation OPTION."
137 (nth 2 option))
138
139(defun guix-operation-option-value (option)
140 "Return boolean value of the operation OPTION."
141 (symbol-value (guix-operation-option-variable option)))
142
143(defun guix-operation-option-string-value (option)
144 "Convert boolean value of the operation OPTION to string and return it."
145 (if (guix-operation-option-value option)
146 guix-operation-option-true-string
147 guix-operation-option-false-string))
148
149(defun guix-operation-prompt (&optional prompt)
150 "Prompt a user for continuing the current operation.
151Return non-nil, if the operation should be continued; nil otherwise.
152Ask a user with PROMPT for continuing an operation."
153 (let* ((option-keys (mapcar #'guix-operation-option-key
154 guix-operation-options))
155 (keys (append '(?y ?n) option-keys))
156 (prompt (concat (propertize (or prompt "Continue operation?")
157 'face 'minibuffer-prompt)
158 " ("
159 (mapconcat
160 (lambda (key)
161 (propertize (string key)
162 'face 'guix-operation-option-key))
163 keys
164 ", ")
165 ") ")))
166 (let ((mode-line mode-line-format))
167 (prog1 (guix-operation-prompt-1 prompt keys)
168 (setq mode-line-format mode-line)
169 ;; Clear the minibuffer after prompting.
170 (message "")))))
171
172(defun guix-operation-prompt-1 (prompt keys)
173 "This function is internal for `guix-operation-prompt'."
174 (guix-operation-set-mode-line)
175 (let ((key (read-char-choice prompt (cons ?\C-g keys) t)))
176 (cl-case key
177 (?y t)
178 ((?n ?\C-g) nil)
179 (t (let* ((option (guix-operation-option-by-key key))
180 (var (guix-operation-option-variable option)))
181 (set var (not (symbol-value var)))
182 (guix-operation-prompt-1 prompt keys))))))
183
184(defun guix-operation-set-mode-line ()
185 "Display operation options in the mode-line of the current buffer."
186 (setq mode-line-format
187 (concat (propertize " Options: "
188 'face 'mode-line-buffer-id)
189 (mapconcat
190 (lambda (option)
191 (let ((key (guix-operation-option-key option))
192 (name (guix-operation-option-name option))
193 (val (guix-operation-option-string-value option)))
194 (concat name
195 " ("
196 (propertize (string key)
197 'face 'guix-operation-option-key)
198 "): " val)))
199 guix-operation-options
200 guix-operation-option-separator)))
201 (force-mode-line-update))
202
203(defun guix-package-source-path (package-id)
204 "Return a store file path to a source of a package PACKAGE-ID."
205 (message "Calculating the source derivation ...")
206 (guix-eval-read
207 (guix-make-guile-expression
208 'package-source-path package-id)))
209
210(defun guix-package-store-path (package-id)
211 "Return a list of store directories of outputs of package PACKAGE-ID."
212 (message "Calculating the package derivation ...")
213 (guix-eval-read
214 (guix-make-guile-expression
215 'package-store-path package-id)))
216
217(defvar guix-after-source-download-hook nil
218 "Hook run after successful performing a 'source-download' operation.")
219
220(defun guix-package-source-build-derivation (package-id &optional prompt)
221 "Build source derivation of a package PACKAGE-ID.
222Ask a user with PROMPT for continuing an operation."
223 (when (or (not guix-operation-confirm)
224 (guix-operation-prompt (or prompt
225 "Build the source derivation?")))
226 (guix-eval-in-repl
227 (guix-make-guile-expression
228 'package-source-build-derivation
229 package-id
230 :use-substitutes? (or guix-use-substitutes 'f)
231 :dry-run? (or guix-dry-run 'f))
232 nil 'source-download)))
233
234(defun guix-build-package (package-id &optional prompt)
235 "Build package with PACKAGE-ID.
236Ask a user with PROMPT for continuing the build operation."
237 (when (or (not guix-operation-confirm)
238 (guix-operation-prompt (or prompt "Build package?")))
239 (guix-eval-in-repl
240 (format (concat ",run-in-store "
241 "(build-package (package-by-id %d)"
242 " #:use-substitutes? %s"
243 " #:dry-run? %s)")
244 package-id
245 (guix-guile-boolean guix-use-substitutes)
246 (guix-guile-boolean guix-dry-run)))))
247
248;;;###autoload
249(defun guix-apply-manifest (profile file &optional operation-buffer)
250 "Apply manifest from FILE to PROFILE.
251This function has the same meaning as 'guix package --manifest' command.
252See Info node `(guix) Invoking guix package' for details.
253
254Interactively, use the current profile and prompt for manifest
255FILE. With a prefix argument, also prompt for PROFILE."
256 (interactive
257 (let* ((current-profile (guix-ui-current-profile))
258 (profile (if current-prefix-arg
259 (guix-profile-prompt)
260 (or current-profile guix-current-profile)))
261 (file (read-file-name "File with manifest: "))
262 (buffer (and current-profile (current-buffer))))
263 (list profile file buffer)))
264 (when (or (not guix-operation-confirm)
265 (y-or-n-p (format "Apply manifest from '%s' to profile '%s'? "
266 file profile)))
267 (guix-eval-in-repl
268 (guix-make-guile-expression
269 'guix-command
270 "package"
271 (concat "--profile=" (expand-file-name profile))
272 (concat "--manifest=" (expand-file-name file)))
273 operation-buffer)))
274
275
276;;; Executing guix commands
277
278(defcustom guix-run-in-shell-function #'guix-run-in-shell
279 "Function used to run guix command.
280The function is called with a single argument - a command line string."
281 :type '(choice (function-item guix-run-in-shell)
282 (function-item guix-run-in-eshell)
283 (function :tag "Other function"))
284 :group 'guix)
285
286(defcustom guix-shell-buffer-name "*shell*"
287 "Default name of a shell buffer used for running guix commands."
288 :type 'string
289 :group 'guix)
290
291(declare-function comint-send-input "comint" t)
292
293(defun guix-run-in-shell (string)
294 "Run command line STRING in `guix-shell-buffer-name' buffer."
295 (shell guix-shell-buffer-name)
296 (goto-char (point-max))
297 (insert string)
298 (comint-send-input))
299
300(declare-function eshell-send-input "esh-mode" t)
301
302(defun guix-run-in-eshell (string)
303 "Run command line STRING in eshell buffer."
304 (eshell)
305 (goto-char (point-max))
306 (insert string)
307 (eshell-send-input))
308
309(defun guix-run-command-in-shell (args)
310 "Execute 'guix ARGS ...' command in a shell buffer."
311 (funcall guix-run-in-shell-function
312 (guix-command-string args)))
313
314(defun guix-run-command-in-repl (args)
315 "Execute 'guix ARGS ...' command in Guix REPL."
316 (guix-eval-in-repl
317 (apply #'guix-make-guile-expression
318 'guix-command args)))
319
320(defun guix-command-output (args)
321 "Return string with 'guix ARGS ...' output."
322 (cl-multiple-value-bind (output error)
323 (guix-eval (apply #'guix-make-guile-expression
324 'guix-command-output args))
325 ;; Remove trailing new space from the error string.
326 (message (replace-regexp-in-string "\n\\'" "" (read error)))
327 (read output)))
328
329(defun guix-help-string (&optional commands)
330 "Return string with 'guix COMMANDS ... --help' output."
331 (guix-eval-read
332 (apply #'guix-make-guile-expression
333 'help-string commands)))
334
335
336;;; Pull
337
338(defcustom guix-update-after-pull t
339 "If non-nil, update Guix buffers after performing \\[guix-pull]."
340 :type 'boolean
341 :group 'guix)
342
343(defvar guix-after-pull-hook
344 '(guix-restart-repl-after-pull guix-update-buffers-maybe-after-pull)
345 "Hook run after successful performing `guix-pull' operation.")
346
347(defun guix-restart-repl-after-pull ()
348 "Restart Guix REPL after `guix-pull' operation."
349 (guix-repl-exit)
350 (guix-start-process-maybe
351 "Restarting Guix REPL after pull operation ..."))
352
353(defun guix-update-buffers-maybe-after-pull ()
354 "Update buffers depending on `guix-update-after-pull'."
355 (when guix-update-after-pull
356 (mapc #'guix-ui-update-buffer
357 ;; No need to update "generation" buffers.
358 (guix-ui-buffers '(guix-package-list-mode
359 guix-package-info-mode
360 guix-output-list-mode
361 guix-output-info-mode)))
362 (message "Guix buffers have been updated.")))
363
364;;;###autoload
365(defun guix-pull (&optional verbose)
366 "Run Guix pull operation.
367If VERBOSE is non-nil (with prefix argument), produce verbose output."
368 (interactive "P")
369 (let ((args (and verbose '("--verbose"))))
370 (guix-eval-in-repl
371 (apply #'guix-make-guile-expression
372 'guix-command "pull" args)
373 nil 'pull)))
374
375(provide 'guix-base)
376
377;;; guix-base.el ends here
diff --git a/emacs/guix-buffer.el b/emacs/guix-buffer.el
deleted file mode 100644
index 4cefe9989e2..00000000000
--- a/emacs/guix-buffer.el
+++ /dev/null
@@ -1,624 +0,0 @@
1;;; guix-buffer.el --- Buffer interface for displaying data -*- lexical-binding: t -*-
2
3;; Copyright © 2014, 2015 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 general 'buffer' interface for displaying an
23;; arbitrary data.
24
25;;; Code:
26
27(require 'cl-lib)
28(require 'guix-history)
29(require 'guix-utils)
30
31(defvar guix-buffer-map
32 (let ((map (make-sparse-keymap)))
33 (define-key map (kbd "l") 'guix-history-back)
34 (define-key map (kbd "r") 'guix-history-forward)
35 (define-key map (kbd "g") 'revert-buffer)
36 (define-key map (kbd "R") 'guix-buffer-redisplay)
37 map)
38 "Parent keymap for Guix buffer modes.")
39
40
41;;; Buffer item
42
43(cl-defstruct (guix-buffer-item
44 (:constructor nil)
45 (:constructor guix-buffer-make-item
46 (entries buffer-type entry-type args))
47 (:copier nil))
48 entries buffer-type entry-type args)
49
50(defvar-local guix-buffer-item nil
51 "Data (structure) for the current Guix buffer.
52The structure consists of the following elements:
53
54- `entries': list of the currently displayed entries.
55
56 Each element of the list is an alist with an entry data of the
57 following form:
58
59 ((PARAM . VAL) ...)
60
61 PARAM is a name of the entry parameter.
62 VAL is a value of this parameter.
63
64- `entry-type': type of the currently displayed entries.
65
66- `buffer-type': type of the current buffer.
67
68- `args': search arguments used to get the current entries.")
69(put 'guix-buffer-item 'permanent-local t)
70
71(defmacro guix-buffer-with-item (item &rest body)
72 "Evaluate BODY using buffer ITEM.
73The following local variables are available inside BODY:
74`%entries', `%buffer-type', `%entry-type', `%args'.
75See `guix-buffer-item' for details."
76 (declare (indent 1) (debug t))
77 (let ((item-var (make-symbol "item")))
78 `(let ((,item-var ,item))
79 (let ((%entries (guix-buffer-item-entries ,item-var))
80 (%buffer-type (guix-buffer-item-buffer-type ,item-var))
81 (%entry-type (guix-buffer-item-entry-type ,item-var))
82 (%args (guix-buffer-item-args ,item-var)))
83 ,@body))))
84
85(defmacro guix-buffer-with-current-item (&rest body)
86 "Evaluate BODY using `guix-buffer-item'.
87See `guix-buffer-with-item' for details."
88 (declare (indent 0) (debug t))
89 `(guix-buffer-with-item guix-buffer-item
90 ,@body))
91
92(defmacro guix-buffer-define-current-item-accessor (name)
93 "Define `guix-buffer-current-NAME' function to access NAME
94element of `guix-buffer-item' structure.
95NAME should be a symbol."
96 (let* ((name-str (symbol-name name))
97 (accessor (intern (concat "guix-buffer-item-" name-str)))
98 (fun-name (intern (concat "guix-buffer-current-" name-str)))
99 (doc (format "\
100Return '%s' of the current Guix buffer.
101See `guix-buffer-item' for details."
102 name-str)))
103 `(defun ,fun-name ()
104 ,doc
105 (and guix-buffer-item
106 (,accessor guix-buffer-item)))))
107
108(defmacro guix-buffer-define-current-item-accessors (&rest names)
109 "Define `guix-buffer-current-NAME' functions for NAMES.
110See `guix-buffer-define-current-item-accessor' for details."
111 `(progn
112 ,@(mapcar (lambda (name)
113 `(guix-buffer-define-current-item-accessor ,name))
114 names)))
115
116(guix-buffer-define-current-item-accessors
117 entries entry-type buffer-type args)
118
119(defmacro guix-buffer-define-current-args-accessor (n prefix name)
120 "Define `PREFIX-NAME' function to access Nth element of 'args'
121field of `guix-buffer-item' structure.
122PREFIX and NAME should be strings."
123 (let ((fun-name (intern (concat prefix "-" name)))
124 (doc (format "\
125Return '%s' of the current Guix buffer.
126'%s' is the element number %d in 'args' of `guix-buffer-item'."
127 name name n)))
128 `(defun ,fun-name ()
129 ,doc
130 (nth ,n (guix-buffer-current-args)))))
131
132(defmacro guix-buffer-define-current-args-accessors (prefix &rest names)
133 "Define `PREFIX-NAME' functions for NAMES.
134See `guix-buffer-define-current-args-accessor' for details."
135 `(progn
136 ,@(cl-loop for name in names
137 for i from 0
138 collect `(guix-buffer-define-current-args-accessor
139 ,i ,prefix ,name))))
140
141
142;;; Wrappers for defined variables
143
144(defvar guix-buffer-data nil
145 "Alist with 'buffer' data.
146This alist is filled by `guix-buffer-define-interface' macro.")
147
148(defun guix-buffer-value (buffer-type entry-type symbol)
149 "Return SYMBOL's value for BUFFER-TYPE/ENTRY-TYPE from `guix-buffer-data'."
150 (symbol-value
151 (guix-assq-value guix-buffer-data buffer-type entry-type symbol)))
152
153(defun guix-buffer-get-entries (buffer-type entry-type args)
154 "Return ENTRY-TYPE entries.
155Call an appropriate 'get-entries' function from `guix-buffer'
156using ARGS as its arguments."
157 (apply (guix-buffer-value buffer-type entry-type 'get-entries)
158 args))
159
160(defun guix-buffer-mode-enable (buffer-type entry-type)
161 "Turn on major mode to display ENTRY-TYPE ENTRIES in BUFFER-TYPE buffer."
162 (funcall (guix-buffer-value buffer-type entry-type 'mode)))
163
164(defun guix-buffer-mode-initialize (buffer-type entry-type)
165 "Set up the current BUFFER-TYPE buffer to display ENTRY-TYPE entries."
166 (let ((fun (guix-buffer-value buffer-type entry-type 'mode-init)))
167 (when fun
168 (funcall fun))))
169
170(defun guix-buffer-insert-entries (entries buffer-type entry-type)
171 "Show ENTRY-TYPE ENTRIES in the current BUFFER-TYPE buffer."
172 (funcall (guix-buffer-value buffer-type entry-type 'insert-entries)
173 entries))
174
175(defun guix-buffer-show-entries-default (entries buffer-type entry-type)
176 "Show ENTRY-TYPE ENTRIES in the current BUFFER-TYPE buffer."
177 (let ((inhibit-read-only t))
178 (erase-buffer)
179 (guix-buffer-mode-enable buffer-type entry-type)
180 (guix-buffer-insert-entries entries buffer-type entry-type)
181 (goto-char (point-min))))
182
183(defun guix-buffer-show-entries (entries buffer-type entry-type)
184 "Show ENTRY-TYPE ENTRIES in the current BUFFER-TYPE buffer."
185 (funcall (guix-buffer-value buffer-type entry-type 'show-entries)
186 entries))
187
188(defun guix-buffer-message (entries buffer-type entry-type args)
189 "Display a message for BUFFER-ITEM after showing entries."
190 (let ((fun (guix-buffer-value buffer-type entry-type 'message)))
191 (when fun
192 (apply fun entries args))))
193
194(defun guix-buffer-name (buffer-type entry-type args)
195 "Return name of BUFFER-TYPE buffer for displaying ENTRY-TYPE entries."
196 (let ((str-or-fun (guix-buffer-value buffer-type entry-type
197 'buffer-name)))
198 (if (stringp str-or-fun)
199 str-or-fun
200 (apply str-or-fun args))))
201
202(defun guix-buffer-param-title (buffer-type entry-type param)
203 "Return PARAM title for BUFFER-TYPE/ENTRY-TYPE."
204 (or (guix-assq-value (guix-buffer-value buffer-type entry-type 'titles)
205 param)
206 ;; Fallback to a title defined in 'info' interface.
207 (unless (eq buffer-type 'info)
208 (guix-assq-value (guix-buffer-value 'info entry-type 'titles)
209 param))
210 (guix-symbol-title param)))
211
212(defun guix-buffer-history-size (buffer-type entry-type)
213 "Return history size for BUFFER-TYPE/ENTRY-TYPE."
214 (guix-buffer-value buffer-type entry-type 'history-size))
215
216(defun guix-buffer-revert-confirm? (buffer-type entry-type)
217 "Return 'revert-confirm' value for BUFFER-TYPE/ENTRY-TYPE."
218 (guix-buffer-value buffer-type entry-type 'revert-confirm))
219
220
221;;; Displaying entries
222
223(defun guix-buffer-display (buffer)
224 "Switch to a Guix BUFFER."
225 (pop-to-buffer buffer
226 '((display-buffer-reuse-window
227 display-buffer-same-window))))
228
229(defun guix-buffer-history-item (buffer-item)
230 "Make and return a history item for displaying BUFFER-ITEM."
231 (list #'guix-buffer-set buffer-item))
232
233(defun guix-buffer-set (buffer-item &optional history)
234 "Set up the current buffer for displaying BUFFER-ITEM.
235HISTORY should be one of the following:
236
237 `nil' - do not save BUFFER-ITEM in history,
238
239 `add' - add it to history,
240
241 `replace' - replace the current history item."
242 (guix-buffer-with-item buffer-item
243 (when %entries
244 ;; Set buffer item before showing entries, so that its value can
245 ;; be used by the code for displaying entries.
246 (setq guix-buffer-item buffer-item)
247 (guix-buffer-show-entries %entries %buffer-type %entry-type)
248 (when history
249 (funcall (cl-ecase history
250 (add #'guix-history-add)
251 (replace #'guix-history-replace))
252 (guix-buffer-history-item buffer-item))))
253 (guix-buffer-message %entries %buffer-type %entry-type %args)))
254
255(defun guix-buffer-display-entries-current
256 (entries buffer-type entry-type args &optional history)
257 "Show ENTRIES in the current Guix buffer.
258See `guix-buffer-item' for the meaning of BUFFER-TYPE, ENTRY-TYPE
259and ARGS, and `guix-buffer-set' for the meaning of HISTORY."
260 (let ((item (guix-buffer-make-item entries buffer-type
261 entry-type args)))
262 (guix-buffer-set item history)))
263
264(defun guix-buffer-get-display-entries-current
265 (buffer-type entry-type args &optional history)
266 "Search for entries and show them in the current Guix buffer.
267See `guix-buffer-display-entries-current' for details."
268 (guix-buffer-display-entries-current
269 (guix-buffer-get-entries buffer-type entry-type args)
270 buffer-type entry-type args history))
271
272(defun guix-buffer-display-entries
273 (entries buffer-type entry-type args &optional history)
274 "Show ENTRIES in a BUFFER-TYPE buffer.
275See `guix-buffer-display-entries-current' for details."
276 (let ((buffer (get-buffer-create
277 (guix-buffer-name buffer-type entry-type args))))
278 (with-current-buffer buffer
279 (guix-buffer-display-entries-current
280 entries buffer-type entry-type args history))
281 (when entries
282 (guix-buffer-display buffer))))
283
284(defun guix-buffer-get-display-entries
285 (buffer-type entry-type args &optional history)
286 "Search for entries and show them in a BUFFER-TYPE buffer.
287See `guix-buffer-display-entries-current' for details."
288 (guix-buffer-display-entries
289 (guix-buffer-get-entries buffer-type entry-type args)
290 buffer-type entry-type args history))
291
292(defun guix-buffer-revert (_ignore-auto noconfirm)
293 "Update the data in the current Guix buffer.
294This function is suitable for `revert-buffer-function'.
295See `revert-buffer' for the meaning of NOCONFIRM."
296 (guix-buffer-with-current-item
297 (when (or noconfirm
298 (not (guix-buffer-revert-confirm? %buffer-type %entry-type))
299 (y-or-n-p "Update the current buffer? "))
300 (guix-buffer-get-display-entries-current
301 %buffer-type %entry-type %args 'replace))))
302
303(defvar guix-buffer-after-redisplay-hook nil
304 "Hook run by `guix-buffer-redisplay'.
305This hook is called before seting up a window position.")
306
307(defun guix-buffer-redisplay ()
308 "Redisplay the current Guix buffer.
309Restore the point and window positions after redisplaying.
310
311This function does not update the buffer data, use
312'\\[revert-buffer]' if you want the full update."
313 (interactive)
314 (let* ((old-point (point))
315 ;; For simplicity, ignore an unlikely case when multiple
316 ;; windows display the same buffer.
317 (window (car (get-buffer-window-list (current-buffer) nil t)))
318 (window-start (and window (window-start window))))
319 (guix-buffer-set guix-buffer-item)
320 (goto-char old-point)
321 (run-hooks 'guix-buffer-after-redisplay-hook)
322 (when window
323 (set-window-point window (point))
324 (set-window-start window window-start))))
325
326(defun guix-buffer-redisplay-goto-button ()
327 "Redisplay the current buffer and go to the next button, if needed."
328 (let ((guix-buffer-after-redisplay-hook
329 (cons (lambda ()
330 (unless (button-at (point))
331 (forward-button 1)))
332 guix-buffer-after-redisplay-hook)))
333 (guix-buffer-redisplay)))
334
335
336;;; Interface definers
337
338(defmacro guix-define-groups (type &rest args)
339 "Define `guix-TYPE' and `guix-TYPE-faces' custom groups.
340Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
341
342Optional keywords:
343
344 - `:parent-group' - name of a parent custom group.
345
346 - `:parent-faces-group' - name of a parent custom faces group.
347
348 - `:group-doc' - docstring of a `guix-TYPE' group.
349
350 - `:faces-group-doc' - docstring of a `guix-TYPE-faces' group."
351 (declare (indent 1))
352 (let* ((type-str (symbol-name type))
353 (prefix (concat "guix-" type-str))
354 (group (intern prefix))
355 (faces-group (intern (concat prefix "-faces"))))
356 (guix-keyword-args-let args
357 ((parent-group :parent-group 'guix)
358 (parent-faces-group :parent-faces-group 'guix-faces)
359 (group-doc :group-doc
360 (format "Settings for '%s' buffers."
361 type-str))
362 (faces-group-doc :faces-group-doc
363 (format "Faces for '%s' buffers."
364 type-str)))
365 `(progn
366 (defgroup ,group nil
367 ,group-doc
368 :group ',parent-group)
369
370 (defgroup ,faces-group nil
371 ,faces-group-doc
372 :group ',group
373 :group ',parent-faces-group)))))
374
375(defmacro guix-define-entry-type (entry-type &rest args)
376 "Define general code for ENTRY-TYPE.
377See `guix-define-groups'."
378 (declare (indent 1))
379 `(guix-define-groups ,entry-type
380 ,@args))
381
382(defmacro guix-define-buffer-type (buffer-type &rest args)
383 "Define general code for BUFFER-TYPE.
384See `guix-define-groups'."
385 (declare (indent 1))
386 `(guix-define-groups ,buffer-type
387 ,@args))
388
389(defmacro guix-buffer-define-interface (buffer-type entry-type &rest args)
390 "Define BUFFER-TYPE interface for displaying ENTRY-TYPE entries.
391Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
392In the following description TYPE means ENTRY-TYPE-BUFFER-TYPE.
393
394Required keywords:
395
396 - `:buffer-name' - default value of the generated
397 `guix-TYPE-buffer-name' variable.
398
399 - `:get-entries-function' - default value of the generated
400 `guix-TYPE-get-function' variable.
401
402 - `:show-entries-function' - default value of the generated
403 `guix-TYPE-show-function' variable.
404
405 Alternatively, if `:show-entries-function' is not specified, a
406 default `guix-TYPE-show-entries' will be generated, and the
407 following keyword should be specified instead:
408
409 - `:insert-entries-function' - default value of the generated
410 `guix-TYPE-insert-function' variable.
411
412Optional keywords:
413
414 - `:message-function' - default value of the generated
415 `guix-TYPE-message-function' variable.
416
417 - `:titles' - default value of the generated
418 `guix-TYPE-titles' variable.
419
420 - `:history-size' - default value of the generated
421 `guix-TYPE-history-size' variable.
422
423 - `:revert-confirm?' - default value of the generated
424 `guix-TYPE-revert-confirm' variable.
425
426 - `:mode-name' - name (a string appeared in the mode-line) of
427 the generated `guix-TYPE-mode'.
428
429 - `:mode-init-function' - default value of the generated
430 `guix-TYPE-mode-initialize-function' variable.
431
432 - `:reduced?' - if non-nil, generate only group, faces group
433 and titles variable (if specified); all keywords become
434 optional."
435 (declare (indent 2))
436 (let* ((entry-type-str (symbol-name entry-type))
437 (buffer-type-str (symbol-name buffer-type))
438 (prefix (concat "guix-" entry-type-str "-"
439 buffer-type-str))
440 (group (intern prefix))
441 (faces-group (intern (concat prefix "-faces")))
442 (get-entries-var (intern (concat prefix "-get-function")))
443 (show-entries-var (intern (concat prefix "-show-function")))
444 (show-entries-fun (intern (concat prefix "-show-entries")))
445 (message-var (intern (concat prefix "-message-function")))
446 (buffer-name-var (intern (concat prefix "-buffer-name")))
447 (titles-var (intern (concat prefix "-titles")))
448 (history-size-var (intern (concat prefix "-history-size")))
449 (revert-confirm-var (intern (concat prefix "-revert-confirm"))))
450 (guix-keyword-args-let args
451 ((get-entries-val :get-entries-function)
452 (show-entries-val :show-entries-function)
453 (insert-entries-val :insert-entries-function)
454 (mode-name :mode-name (capitalize prefix))
455 (mode-init-val :mode-init-function)
456 (message-val :message-function)
457 (buffer-name-val :buffer-name)
458 (titles-val :titles)
459 (history-size-val :history-size 20)
460 (revert-confirm-val :revert-confirm? t)
461 (reduced? :reduced?))
462 `(progn
463 (defgroup ,group nil
464 ,(format "Displaying '%s' entries in '%s' buffer."
465 entry-type-str buffer-type-str)
466 :group ',(intern (concat "guix-" entry-type-str))
467 :group ',(intern (concat "guix-" buffer-type-str)))
468
469 (defgroup ,faces-group nil
470 ,(format "Faces for displaying '%s' entries in '%s' buffer."
471 entry-type-str buffer-type-str)
472 :group ',group
473 :group ',(intern (concat "guix-" entry-type-str "-faces"))
474 :group ',(intern (concat "guix-" buffer-type-str "-faces")))
475
476 (defcustom ,titles-var ,titles-val
477 ,(format "Alist of titles of '%s' parameters."
478 entry-type-str)
479 :type '(alist :key-type symbol :value-type string)
480 :group ',group)
481
482 ,(unless reduced?
483 `(progn
484 (defvar ,get-entries-var ,get-entries-val
485 ,(format "\
486Function used to receive '%s' entries for '%s' buffer."
487 entry-type-str buffer-type-str))
488
489 (defvar ,show-entries-var
490 ,(or show-entries-val `',show-entries-fun)
491 ,(format "\
492Function used to show '%s' entries in '%s' buffer."
493 entry-type-str buffer-type-str))
494
495 (defvar ,message-var ,message-val
496 ,(format "\
497Function used to display a message after showing '%s' entries.
498If nil, do not display messages."
499 entry-type-str))
500
501 (defcustom ,buffer-name-var ,buffer-name-val
502 ,(format "\
503Default name of '%s' buffer for displaying '%s' entries.
504May be a string or a function returning a string. The function
505is called with the same arguments as `%S'."
506 buffer-type-str entry-type-str get-entries-var)
507 :type '(choice string function)
508 :group ',group)
509
510 (defcustom ,history-size-var ,history-size-val
511 ,(format "\
512Maximum number of items saved in history of `%S' buffer.
513If 0, the history is disabled."
514 buffer-name-var)
515 :type 'integer
516 :group ',group)
517
518 (defcustom ,revert-confirm-var ,revert-confirm-val
519 ,(format "\
520If non-nil, ask to confirm for reverting `%S' buffer."
521 buffer-name-var)
522 :type 'boolean
523 :group ',group)
524
525 (guix-alist-put!
526 '((get-entries . ,get-entries-var)
527 (show-entries . ,show-entries-var)
528 (message . ,message-var)
529 (buffer-name . ,buffer-name-var)
530 (history-size . ,history-size-var)
531 (revert-confirm . ,revert-confirm-var))
532 'guix-buffer-data ',buffer-type ',entry-type)
533
534 ,(unless show-entries-val
535 `(defun ,show-entries-fun (entries)
536 ,(format "\
537Show '%s' ENTRIES in the current '%s' buffer."
538 entry-type-str buffer-type-str)
539 (guix-buffer-show-entries-default
540 entries ',buffer-type ',entry-type)))
541
542 ,(when (or insert-entries-val
543 (null show-entries-val))
544 (let ((insert-entries-var
545 (intern (concat prefix "-insert-function"))))
546 `(progn
547 (defvar ,insert-entries-var ,insert-entries-val
548 ,(format "\
549Function used to print '%s' entries in '%s' buffer."
550 entry-type-str buffer-type-str))
551
552 (guix-alist-put!
553 ',insert-entries-var 'guix-buffer-data
554 ',buffer-type ',entry-type
555 'insert-entries))))
556
557 ,(when (or mode-name
558 mode-init-val
559 (null show-entries-val))
560 (let* ((mode-str (concat prefix "-mode"))
561 (mode-map-str (concat mode-str "-map"))
562 (mode (intern mode-str))
563 (parent-mode (intern
564 (concat "guix-" buffer-type-str
565 "-mode")))
566 (mode-var (intern
567 (concat mode-str "-function")))
568 (mode-init-var (intern
569 (concat mode-str
570 "-initialize-function"))))
571 `(progn
572 (defvar ,mode-var ',mode
573 ,(format "\
574Major mode for displaying '%s' entries in '%s' buffer."
575 entry-type-str buffer-type-str))
576
577 (defvar ,mode-init-var ,mode-init-val
578 ,(format "\
579Function used to set up '%s' buffer for displaying '%s' entries."
580 buffer-type-str entry-type-str))
581
582 (define-derived-mode ,mode ,parent-mode ,mode-name
583 ,(format "\
584Major mode for displaying '%s' entries in '%s' buffer.
585
586\\{%s}"
587 entry-type-str buffer-type-str mode-map-str)
588 (setq-local revert-buffer-function
589 'guix-buffer-revert)
590 (setq-local guix-history-size
591 (guix-buffer-history-size
592 ',buffer-type ',entry-type))
593 (guix-buffer-mode-initialize
594 ',buffer-type ',entry-type))
595
596 (guix-alist-put!
597 ',mode-var 'guix-buffer-data
598 ',buffer-type ',entry-type 'mode)
599 (guix-alist-put!
600 ',mode-init-var 'guix-buffer-data
601 ',buffer-type ',entry-type
602 'mode-init))))))
603
604 (guix-alist-put!
605 ',titles-var 'guix-buffer-data
606 ',buffer-type ',entry-type 'titles)))))
607
608
609(defvar guix-buffer-font-lock-keywords
610 (eval-when-compile
611 `((,(rx "(" (group (or "guix-buffer-with-item"
612 "guix-buffer-with-current-item"
613 "guix-buffer-define-interface"
614 "guix-define-groups"
615 "guix-define-entry-type"
616 "guix-define-buffer-type"))
617 symbol-end)
618 . 1))))
619
620(font-lock-add-keywords 'emacs-lisp-mode guix-buffer-font-lock-keywords)
621
622(provide 'guix-buffer)
623
624;;; guix-buffer.el ends here
diff --git a/emacs/guix-build-log.el b/emacs/guix-build-log.el
deleted file mode 100644
index f67be16326c..00000000000
--- a/emacs/guix-build-log.el
+++ /dev/null
@@ -1,381 +0,0 @@
1;;; guix-build-log.el --- Major and minor modes for build logs -*- lexical-binding: t -*-
2
3;; Copyright © 2015 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 major mode (`guix-build-log-mode') and a minor mode
23;; (`guix-build-log-minor-mode') for highlighting Guix build logs.
24
25;;; Code:
26
27(require 'guix-utils)
28
29(defgroup guix-build-log nil
30 "Settings for `guix-build-log-mode'."
31 :group 'guix)
32
33(defgroup guix-build-log-faces nil
34 "Faces for `guix-build-log-mode'."
35 :group 'guix-build-log
36 :group 'guix-faces)
37
38(defface guix-build-log-title-head
39 '((t :inherit font-lock-keyword-face))
40 "Face for '@' symbol of a log title."
41 :group 'guix-build-log-faces)
42
43(defface guix-build-log-title-start
44 '((t :inherit guix-build-log-title-head))
45 "Face for a log title denoting a start of a process."
46 :group 'guix-build-log-faces)
47
48(defface guix-build-log-title-success
49 '((t :inherit guix-build-log-title-head))
50 "Face for a log title denoting a successful end of a process."
51 :group 'guix-build-log-faces)
52
53(defface guix-build-log-title-fail
54 '((t :inherit error))
55 "Face for a log title denoting a failed end of a process."
56 :group 'guix-build-log-faces)
57
58(defface guix-build-log-title-end
59 '((t :inherit guix-build-log-title-head))
60 "Face for a log title denoting an undefined end of a process."
61 :group 'guix-build-log-faces)
62
63(defface guix-build-log-phase-name
64 '((t :inherit font-lock-function-name-face))
65 "Face for a phase name."
66 :group 'guix-build-log-faces)
67
68(defface guix-build-log-phase-start
69 '((default :weight bold)
70 (((class grayscale) (background light)) :foreground "Gray90")
71 (((class grayscale) (background dark)) :foreground "DimGray")
72 (((class color) (min-colors 16) (background light))
73 :foreground "DarkGreen")
74 (((class color) (min-colors 16) (background dark))
75 :foreground "LimeGreen")
76 (((class color) (min-colors 8)) :foreground "green"))
77 "Face for the start line of a phase."
78 :group 'guix-build-log-faces)
79
80(defface guix-build-log-phase-end
81 '((((class grayscale) (background light)) :foreground "Gray90")
82 (((class grayscale) (background dark)) :foreground "DimGray")
83 (((class color) (min-colors 16) (background light))
84 :foreground "ForestGreen")
85 (((class color) (min-colors 16) (background dark))
86 :foreground "LightGreen")
87 (((class color) (min-colors 8)) :foreground "green")
88 (t :weight bold))
89 "Face for the end line of a phase."
90 :group 'guix-build-log-faces)
91
92(defface guix-build-log-phase-success
93 '((t))
94 "Face for the 'succeeded' word of a phase line."
95 :group 'guix-build-log-faces)
96
97(defface guix-build-log-phase-fail
98 '((t :inherit error))
99 "Face for the 'failed' word of a phase line."
100 :group 'guix-build-log-faces)
101
102(defface guix-build-log-phase-seconds
103 '((t :inherit font-lock-constant-face))
104 "Face for the number of seconds for a phase."
105 :group 'guix-build-log-faces)
106
107(defcustom guix-build-log-minor-mode-activate t
108 "If non-nil, then `guix-build-log-minor-mode' is automatically
109activated in `shell-mode' buffers."
110 :type 'boolean
111 :group 'guix-build-log)
112
113(defcustom guix-build-log-mode-hook '()
114 "Hook run after `guix-build-log-mode' is entered."
115 :type 'hook
116 :group 'guix-build-log)
117
118(defvar guix-build-log-phase-name-regexp "`\\([^']+\\)'"
119 "Regexp for a phase name.")
120
121(defvar guix-build-log-phase-start-regexp
122 (concat "^starting phase " guix-build-log-phase-name-regexp)
123 "Regexp for the start line of a 'build' phase.")
124
125(defun guix-build-log-title-regexp (&optional state)
126 "Return regexp for the log title.
127STATE is a symbol denoting a state of the title. It should be
128`start', `fail', `success' or `nil' (for a regexp matching any
129state)."
130 (let* ((word-rx (rx (1+ (any word "-"))))
131 (state-rx (cond ((eq state 'start) (concat word-rx "started"))
132 ((eq state 'success) (concat word-rx "succeeded"))
133 ((eq state 'fail) (concat word-rx "failed"))
134 (t word-rx))))
135 (rx-to-string
136 `(and bol (group "@") " " (group (regexp ,state-rx)))
137 t)))
138
139(defun guix-build-log-phase-end-regexp (&optional state)
140 "Return regexp for the end line of a 'build' phase.
141STATE is a symbol denoting how a build phase was ended. It should be
142`fail', `success' or `nil' (for a regexp matching any state)."
143 (let ((state-rx (cond ((eq state 'success) "succeeded")
144 ((eq state 'fail) "failed")
145 (t (regexp-opt '("succeeded" "failed"))))))
146 (rx-to-string
147 `(and bol "phase " (regexp ,guix-build-log-phase-name-regexp)
148 " " (group (regexp ,state-rx)) " after "
149 (group (1+ (or digit "."))) " seconds")
150 t)))
151
152(defvar guix-build-log-phase-end-regexp
153 ;; For efficiency, it is better to have a regexp for the general line
154 ;; of the phase end, then to call the function all the time.
155 (guix-build-log-phase-end-regexp)
156 "Regexp for the end line of a 'build' phase.")
157
158(defvar guix-build-log-font-lock-keywords
159 `((,(guix-build-log-title-regexp 'start)
160 (1 'guix-build-log-title-head)
161 (2 'guix-build-log-title-start))
162 (,(guix-build-log-title-regexp 'success)
163 (1 'guix-build-log-title-head)
164 (2 'guix-build-log-title-success))
165 (,(guix-build-log-title-regexp 'fail)
166 (1 'guix-build-log-title-head)
167 (2 'guix-build-log-title-fail))
168 (,(guix-build-log-title-regexp)
169 (1 'guix-build-log-title-head)
170 (2 'guix-build-log-title-end))
171 (,guix-build-log-phase-start-regexp
172 (0 'guix-build-log-phase-start)
173 (1 'guix-build-log-phase-name prepend))
174 (,(guix-build-log-phase-end-regexp 'success)
175 (0 'guix-build-log-phase-end)
176 (1 'guix-build-log-phase-name prepend)
177 (2 'guix-build-log-phase-success prepend)
178 (3 'guix-build-log-phase-seconds prepend))
179 (,(guix-build-log-phase-end-regexp 'fail)
180 (0 'guix-build-log-phase-end)
181 (1 'guix-build-log-phase-name prepend)
182 (2 'guix-build-log-phase-fail prepend)
183 (3 'guix-build-log-phase-seconds prepend)))
184 "A list of `font-lock-keywords' for `guix-build-log-mode'.")
185
186(defvar guix-build-log-common-map
187 (let ((map (make-sparse-keymap)))
188 (define-key map (kbd "M-n") 'guix-build-log-next-phase)
189 (define-key map (kbd "M-p") 'guix-build-log-previous-phase)
190 (define-key map (kbd "TAB") 'guix-build-log-phase-toggle)
191 (define-key map (kbd "<tab>") 'guix-build-log-phase-toggle)
192 (define-key map (kbd "<backtab>") 'guix-build-log-phase-toggle-all)
193 (define-key map [(shift tab)] 'guix-build-log-phase-toggle-all)
194 map)
195 "Parent keymap for 'build-log' buffers.
196For `guix-build-log-mode' this map is used as is.
197For `guix-build-log-minor-mode' this map is prefixed with 'C-c'.")
198
199(defvar guix-build-log-mode-map
200 (let ((map (make-sparse-keymap)))
201 (set-keymap-parent
202 map (make-composed-keymap (list guix-build-log-common-map)
203 special-mode-map))
204 (define-key map (kbd "c") 'compilation-shell-minor-mode)
205 (define-key map (kbd "v") 'view-mode)
206 map)
207 "Keymap for `guix-build-log-mode' buffers.")
208
209(defvar guix-build-log-minor-mode-map
210 (let ((map (make-sparse-keymap)))
211 (define-key map (kbd "C-c") guix-build-log-common-map)
212 map)
213 "Keymap for `guix-build-log-minor-mode' buffers.")
214
215(defun guix-build-log-phase-start (&optional with-header?)
216 "Return the start point of the current build phase.
217If WITH-HEADER? is non-nil, do not skip 'starting phase ...' header.
218Return nil, if there is no phase start before the current point."
219 (save-excursion
220 (end-of-line)
221 (when (re-search-backward guix-build-log-phase-start-regexp nil t)
222 (unless with-header? (end-of-line))
223 (point))))
224
225(defun guix-build-log-phase-end ()
226 "Return the end point of the current build phase."
227 (save-excursion
228 (beginning-of-line)
229 (when (re-search-forward guix-build-log-phase-end-regexp nil t)
230 (point))))
231
232(defun guix-build-log-phase-hide ()
233 "Hide the body of the current build phase."
234 (interactive)
235 (let ((beg (guix-build-log-phase-start))
236 (end (guix-build-log-phase-end)))
237 (when (and beg end)
238 ;; If not on the header line, move to it.
239 (when (and (> (point) beg)
240 (< (point) end))
241 (goto-char (guix-build-log-phase-start t)))
242 (remove-overlays beg end 'invisible t)
243 (let ((o (make-overlay beg end)))
244 (overlay-put o 'evaporate t)
245 (overlay-put o 'invisible t)))))
246
247(defun guix-build-log-phase-show ()
248 "Show the body of the current build phase."
249 (interactive)
250 (let ((beg (guix-build-log-phase-start))
251 (end (guix-build-log-phase-end)))
252 (when (and beg end)
253 (remove-overlays beg end 'invisible t))))
254
255(defun guix-build-log-phase-hidden-p ()
256 "Return non-nil, if the body of the current build phase is hidden."
257 (let ((beg (guix-build-log-phase-start)))
258 (and beg
259 (cl-some (lambda (o)
260 (overlay-get o 'invisible))
261 (overlays-at beg)))))
262
263(defun guix-build-log-phase-toggle-function ()
264 "Return a function to toggle the body of the current build phase."
265 (if (guix-build-log-phase-hidden-p)
266 #'guix-build-log-phase-show
267 #'guix-build-log-phase-hide))
268
269(defun guix-build-log-phase-toggle ()
270 "Show/hide the body of the current build phase."
271 (interactive)
272 (funcall (guix-build-log-phase-toggle-function)))
273
274(defun guix-build-log-phase-toggle-all ()
275 "Show/hide the bodies of all build phases."
276 (interactive)
277 (save-excursion
278 ;; Some phases may be hidden, and some shown. Whether to hide or to
279 ;; show them, it is determined by the state of the first phase here.
280 (goto-char (point-min))
281 (let ((fun (save-excursion
282 (re-search-forward guix-build-log-phase-start-regexp nil t)
283 (guix-build-log-phase-toggle-function))))
284 (while (re-search-forward guix-build-log-phase-start-regexp nil t)
285 (funcall fun)))))
286
287(defun guix-build-log-next-phase (&optional arg)
288 "Move to the next build phase.
289With ARG, do it that many times. Negative ARG means move
290backward."
291 (interactive "^p")
292 (if arg
293 (when (zerop arg) (user-error "Try again"))
294 (setq arg 1))
295 (let ((search-fun (if (> arg 0)
296 #'re-search-forward
297 #'re-search-backward))
298 (n (abs arg))
299 found last-found)
300 (save-excursion
301 (end-of-line (if (> arg 0) 1 0)) ; skip the current line
302 (while (and (not (zerop n))
303 (setq found
304 (funcall search-fun
305 guix-build-log-phase-start-regexp
306 nil t)))
307 (setq n (1- n)
308 last-found found)))
309 (when last-found
310 (goto-char last-found)
311 (forward-line 0))
312 (or found
313 (user-error (if (> arg 0)
314 "No next build phase"
315 "No previous build phase")))))
316
317(defun guix-build-log-previous-phase (&optional arg)
318 "Move to the previous build phase.
319With ARG, do it that many times. Negative ARG means move
320forward."
321 (interactive "^p")
322 (guix-build-log-next-phase (- (or arg 1))))
323
324;;;###autoload
325(define-derived-mode guix-build-log-mode special-mode
326 "Guix-Build-Log"
327 "Major mode for viewing Guix build logs.
328
329\\{guix-build-log-mode-map}"
330 (setq font-lock-defaults '(guix-build-log-font-lock-keywords t)))
331
332;;;###autoload
333(define-minor-mode guix-build-log-minor-mode
334 "Toggle Guix Build Log minor mode.
335
336With a prefix argument ARG, enable Guix Build Log minor mode if
337ARG is positive, and disable it otherwise. If called from Lisp,
338enable the mode if ARG is omitted or nil.
339
340When Guix Build Log minor mode is enabled, it highlights build
341log in the current buffer. This mode can be enabled
342programmatically using hooks:
343
344 (add-hook 'shell-mode-hook 'guix-build-log-minor-mode)
345
346\\{guix-build-log-minor-mode-map}"
347 :init-value nil
348 :lighter " Guix-Build-Log"
349 :keymap guix-build-log-minor-mode-map
350 :group 'guix-build-log
351 (if guix-build-log-minor-mode
352 (font-lock-add-keywords nil guix-build-log-font-lock-keywords)
353 (font-lock-remove-keywords nil guix-build-log-font-lock-keywords))
354 (when font-lock-mode
355 (font-lock-fontify-buffer)))
356
357;;;###autoload
358(defun guix-build-log-minor-mode-activate-maybe ()
359 "Activate `guix-build-log-minor-mode' depending on
360`guix-build-log-minor-mode-activate' variable."
361 (when guix-build-log-minor-mode-activate
362 (guix-build-log-minor-mode)))
363
364(defun guix-build-log-find-file (file-or-url)
365 "Open FILE-OR-URL in `guix-build-log-mode'."
366 (guix-find-file-or-url file-or-url)
367 (guix-build-log-mode))
368
369;;;###autoload
370(add-hook 'shell-mode-hook 'guix-build-log-minor-mode-activate-maybe)
371
372;;;###autoload
373(add-to-list 'auto-mode-alist
374 ;; Regexp for log files (usually placed in /var/log/guix/...)
375 (cons (rx "/guix/drvs/" (= 2 alnum) "/" (= 30 alnum)
376 "-" (+ (any alnum "-+.")) ".drv" string-end)
377 'guix-build-log-mode))
378
379(provide 'guix-build-log)
380
381;;; guix-build-log.el ends here
diff --git a/emacs/guix-command.el b/emacs/guix-command.el
deleted file mode 100644
index 7069c516495..00000000000
--- a/emacs/guix-command.el
+++ /dev/null
@@ -1,830 +0,0 @@
1;;; guix-command.el --- Popup interface for guix commands -*- lexical-binding: t -*-
2
3;; Copyright © 2015, 2016 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 magit-like popup interface for running guix
23;; commands in Guix REPL. The entry point is "M-x guix". When it is
24;; called the first time, "guix --help" output is parsed and
25;; `guix-COMMAND-action' functions are generated for each available guix
26;; COMMAND. Then a window with these commands is popped up. When a
27;; particular COMMAND is called, "guix COMMAND --help" output is parsed,
28;; and a user get a new popup window with available options for this
29;; command and so on.
30
31;; To avoid hard-coding all guix options, actions, etc., as much data is
32;; taken from "guix ... --help" outputs as possible. But this data is
33;; still incomplete: not all long options have short analogs, also
34;; special readers should be used for some options (for example, to
35;; complete package names while prompting for a package). So after
36;; parsing --help output, the arguments are "improved". All arguments
37;; (switches, options and actions) are `guix-command-argument'
38;; structures.
39
40;; Only "M-x guix" command is available after this file is loaded. The
41;; rest commands/actions/popups are generated on the fly only when they
42;; are needed (that's why there is a couple of `eval'-s in this file).
43
44;; COMMANDS argument is used by many functions in this file. It means a
45;; list of guix commands without "guix" itself, e.g.: ("build"),
46;; ("import" "gnu"). The empty list stands for the plain "guix" without
47;; subcommands.
48
49;; All actions in popup windows are divided into 2 groups:
50;;
51;; - 'Popup' actions - used to pop up another window. For example, every
52;; action in the 'guix' or 'guix import' window is a popup action. They
53;; are defined by `guix-command-define-popup-action' macro.
54;;
55;; - 'Execute' actions - used to do something with the command line (to
56;; run a command in Guix REPL or to copy it into kill-ring) constructed
57;; with the current popup. They are defined by
58;; `guix-command-define-execute-action' macro.
59
60;;; Code:
61
62(require 'cl-lib)
63(require 'guix-popup)
64(require 'guix-utils)
65(require 'guix-help-vars)
66(require 'guix-read)
67(require 'guix-base)
68(require 'guix-build-log)
69(require 'guix-guile)
70(require 'guix-external)
71
72(defgroup guix-commands nil
73 "Settings for guix popup windows."
74 :group 'guix)
75
76(defvar guix-command-complex-with-shared-arguments
77 '("system")
78 "List of guix commands which have subcommands with shared options.
79I.e., 'guix foo --help' is the same as 'guix foo bar --help'.")
80
81(defun guix-command-action-name (&optional commands &rest name-parts)
82 "Return name of action function for guix COMMANDS."
83 (guix-command-symbol (append commands name-parts (list "action"))))
84
85
86;;; Command arguments
87
88(cl-defstruct (guix-command-argument
89 (:constructor guix-command-make-argument)
90 (:copier guix-command-copy-argument))
91 name char doc fun switch? option? action?)
92
93(cl-defun guix-command-modify-argument
94 (argument &key
95 (name nil name-bound?)
96 (char nil char-bound?)
97 (doc nil doc-bound?)
98 (fun nil fun-bound?)
99 (switch? nil switch?-bound?)
100 (option? nil option?-bound?)
101 (action? nil action?-bound?))
102 "Return a modified version of ARGUMENT."
103 (declare (indent 1))
104 (let ((copy (guix-command-copy-argument argument)))
105 (and name-bound? (setf (guix-command-argument-name copy) name))
106 (and char-bound? (setf (guix-command-argument-char copy) char))
107 (and doc-bound? (setf (guix-command-argument-doc copy) doc))
108 (and fun-bound? (setf (guix-command-argument-fun copy) fun))
109 (and switch?-bound? (setf (guix-command-argument-switch? copy) switch?))
110 (and option?-bound? (setf (guix-command-argument-option? copy) option?))
111 (and action?-bound? (setf (guix-command-argument-action? copy) action?))
112 copy))
113
114(defun guix-command-modify-argument-from-alist (argument alist)
115 "Return a modified version of ARGUMENT or nil if it wasn't modified.
116Each assoc from ALIST have a form (NAME . PLIST). NAME is an
117argument name. PLIST is a property list of argument parameters
118to be modified."
119 (let* ((name (guix-command-argument-name argument))
120 (plist (guix-assoc-value alist name)))
121 (when plist
122 (apply #'guix-command-modify-argument
123 argument plist))))
124
125(defmacro guix-command-define-argument-improver (name alist)
126 "Define NAME variable and function to modify an argument from ALIST."
127 (declare (indent 1))
128 `(progn
129 (defvar ,name ,alist)
130 (defun ,name (argument)
131 (guix-command-modify-argument-from-alist argument ,name))))
132
133(guix-command-define-argument-improver
134 guix-command-improve-action-argument
135 '(("container" :char ?C)
136 ("graph" :char ?G)
137 ("environment" :char ?E)
138 ("publish" :char ?u)
139 ("pull" :char ?P)
140 ("size" :char ?z)))
141
142(guix-command-define-argument-improver
143 guix-command-improve-common-argument
144 '(("--help" :switch? nil)
145 ("--version" :switch? nil)))
146
147(guix-command-define-argument-improver
148 guix-command-improve-target-argument
149 '(("--target" :char ?T)))
150
151(guix-command-define-argument-improver
152 guix-command-improve-system-type-argument
153 '(("--system" :fun guix-read-system-type)))
154
155(guix-command-define-argument-improver
156 guix-command-improve-load-path-argument
157 '(("--load-path" :fun read-directory-name)))
158
159(guix-command-define-argument-improver
160 guix-command-improve-search-paths-argument
161 '(("--search-paths" :char ?P)))
162
163(guix-command-define-argument-improver
164 guix-command-improve-substitute-urls-argument
165 '(("--substitute-urls" :char ?U)))
166
167(guix-command-define-argument-improver
168 guix-command-improve-hash-argument
169 '(("--format" :fun guix-read-hash-format)))
170
171(guix-command-define-argument-improver
172 guix-command-improve-key-policy-argument
173 '(("--key-download" :fun guix-read-key-policy)))
174
175(defvar guix-command-improve-common-build-argument
176 '(("--no-substitutes" :char ?s)
177 ("--no-build-hook" :char ?h)
178 ("--max-silent-time" :char ?x)
179 ("--rounds" :char ?R :fun read-number)
180 ("--with-input" :char ?W)))
181
182(defun guix-command-improve-common-build-argument (argument)
183 (guix-command-modify-argument-from-alist
184 argument
185 (append guix-command-improve-load-path-argument
186 guix-command-improve-substitute-urls-argument
187 guix-command-improve-common-build-argument)))
188
189(guix-command-define-argument-improver
190 guix-command-improve-archive-argument
191 '(("--generate-key" :char ?k)))
192
193(guix-command-define-argument-improver
194 guix-command-improve-build-argument
195 '(("--no-grafts" :char ?g)
196 ("--file" :fun guix-read-file-name)
197 ("--root" :fun guix-read-file-name)
198 ("--sources" :char ?S :fun guix-read-source-type :switch? nil)
199 ("--with-source" :fun guix-read-file-name)))
200
201(guix-command-define-argument-improver
202 guix-command-improve-environment-argument
203 '(("--ad-hoc"
204 :name "--ad-hoc " :fun guix-read-package-names-string
205 :switch? nil :option? t)
206 ("--expose" :char ?E)
207 ("--share" :char ?S)
208 ("--load" :fun guix-read-file-name)))
209
210(guix-command-define-argument-improver
211 guix-command-improve-gc-argument
212 '(("--list-dead" :char ?D)
213 ("--list-live" :char ?L)
214 ("--referrers" :char ?f)
215 ("--verify" :fun guix-read-verify-options-string)))
216
217(guix-command-define-argument-improver
218 guix-command-improve-graph-argument
219 '(("--type" :fun guix-read-graph-type)))
220
221(guix-command-define-argument-improver
222 guix-command-improve-import-argument
223 '(("cran" :char ?r)))
224
225(guix-command-define-argument-improver
226 guix-command-improve-import-elpa-argument
227 '(("--archive" :fun guix-read-elpa-archive)))
228
229(guix-command-define-argument-improver
230 guix-command-improve-lint-argument
231 '(("--checkers" :fun guix-read-lint-checker-names-string)))
232
233(guix-command-define-argument-improver
234 guix-command-improve-package-argument
235 ;; Unlike all other options, --install/--remove do not have a form
236 ;; '--install=foo,bar' but '--install foo bar' instead, so we need
237 ;; some tweaks.
238 '(("--install"
239 :name "--install " :fun guix-read-package-names-string
240 :switch? nil :option? t)
241 ("--remove"
242 :name "--remove " :fun guix-read-package-names-string
243 :switch? nil :option? t)
244 ("--install-from-file" :fun guix-read-file-name)
245 ("--manifest" :fun guix-read-file-name)
246 ("--profile" :fun guix-read-file-name)
247 ("--do-not-upgrade" :char ?U)
248 ("--roll-back" :char ?R)
249 ("--show" :char ?w :fun guix-read-package-name)))
250
251(guix-command-define-argument-improver
252 guix-command-improve-refresh-argument
253 '(("--select" :fun guix-read-refresh-subset)
254 ("--type" :fun guix-read-refresh-updater-names-string)
255 ("--key-server" :char ?S)))
256
257(guix-command-define-argument-improver
258 guix-command-improve-size-argument
259 '(("--map-file" :fun guix-read-file-name)))
260
261(guix-command-define-argument-improver
262 guix-command-improve-system-argument
263 '(("disk-image" :char ?D)
264 ("vm-image" :char ?V)
265 ("--on-error" :char ?E)
266 ("--no-grub" :char ?g)
267 ("--full-boot" :char ?b)))
268
269(defvar guix-command-argument-improvers
270 '((()
271 guix-command-improve-action-argument)
272 (("archive")
273 guix-command-improve-common-build-argument
274 guix-command-improve-target-argument
275 guix-command-improve-system-type-argument
276 guix-command-improve-archive-argument)
277 (("build")
278 guix-command-improve-common-build-argument
279 guix-command-improve-target-argument
280 guix-command-improve-system-type-argument
281 guix-command-improve-build-argument)
282 (("download")
283 guix-command-improve-hash-argument)
284 (("hash")
285 guix-command-improve-hash-argument)
286 (("environment")
287 guix-command-improve-common-build-argument
288 guix-command-improve-search-paths-argument
289 guix-command-improve-system-type-argument
290 guix-command-improve-environment-argument)
291 (("gc")
292 guix-command-improve-gc-argument)
293 (("graph")
294 guix-command-improve-graph-argument)
295 (("import")
296 guix-command-improve-import-argument)
297 (("import" "gnu")
298 guix-command-improve-key-policy-argument)
299 (("import" "elpa")
300 guix-command-improve-import-elpa-argument)
301 (("lint")
302 guix-command-improve-lint-argument)
303 (("package")
304 guix-command-improve-common-build-argument
305 guix-command-improve-search-paths-argument
306 guix-command-improve-package-argument)
307 (("refresh")
308 guix-command-improve-key-policy-argument
309 guix-command-improve-refresh-argument)
310 (("size")
311 guix-command-improve-system-type-argument
312 guix-command-improve-substitute-urls-argument
313 guix-command-improve-size-argument)
314 (("system")
315 guix-command-improve-common-build-argument
316 guix-command-improve-system-argument))
317 "Alist of guix commands and argument improvers for them.")
318
319(defun guix-command-improve-argument (argument improvers)
320 "Return ARGUMENT modified with IMPROVERS."
321 (or (cl-some (lambda (improver)
322 (funcall improver argument))
323 improvers)
324 argument))
325
326(defun guix-command-improve-arguments (arguments commands)
327 "Return ARGUMENTS for 'guix COMMANDS ...' modified for popup interface."
328 (let ((improvers (cons 'guix-command-improve-common-argument
329 (guix-assoc-value guix-command-argument-improvers
330 commands))))
331 (mapcar (lambda (argument)
332 (guix-command-improve-argument argument improvers))
333 arguments)))
334
335(defun guix-command-parse-arguments (&optional commands)
336 "Return a list of parsed 'guix COMMANDS ...' arguments."
337 (with-temp-buffer
338 (insert (guix-help-string commands))
339 (let (args)
340 (guix-while-search guix-help-parse-option-regexp
341 (let* ((short (match-string-no-properties 1))
342 (name (match-string-no-properties 2))
343 (arg (match-string-no-properties 3))
344 (doc (match-string-no-properties 4))
345 (char (if short
346 (elt short 1) ; short option letter
347 (elt name 2))) ; first letter of the long option
348 ;; If "--foo=bar" or "--foo[=bar]" then it is 'option'.
349 (option? (not (string= "" arg)))
350 ;; If "--foo" or "--foo[=bar]" then it is 'switch'.
351 (switch? (or (string= "" arg)
352 (eq ?\[ (elt arg 0)))))
353 (push (guix-command-make-argument
354 :name name
355 :char char
356 :doc doc
357 :switch? switch?
358 :option? option?)
359 args)))
360 (guix-while-search guix-help-parse-command-regexp
361 (let* ((name (match-string-no-properties 1))
362 (char (elt name 0)))
363 (push (guix-command-make-argument
364 :name name
365 :char char
366 :fun (guix-command-action-name commands name)
367 :action? t)
368 args)))
369 args)))
370
371(defun guix-command-rest-argument (&optional commands)
372 "Return '--' argument for COMMANDS."
373 (cl-flet ((argument (&rest args)
374 (apply #'guix-command-make-argument
375 :name "-- " :char ?= :option? t args)))
376 (let ((command (car commands)))
377 (cond
378 ((member command
379 '("archive" "build" "challenge" "edit"
380 "graph" "lint" "refresh"))
381 (argument :doc "Packages" :fun 'guix-read-package-names-string))
382 ((equal commands '("container" "exec"))
383 (argument :doc "PID Command [Args...]"))
384 ((string= command "download")
385 (argument :doc "URL"))
386 ((string= command "environment")
387 (argument :doc "Command [Args...]" :fun 'read-shell-command))
388 ((string= command "gc")
389 (argument :doc "Paths" :fun 'guix-read-file-name))
390 ((member command '("hash" "system"))
391 (argument :doc "File" :fun 'guix-read-file-name))
392 ((string= command "size")
393 (argument :doc "Package" :fun 'guix-read-package-name))
394 ((equal commands '("import" "nix"))
395 (argument :doc "Nixpkgs Attribute"))
396 ;; Other 'guix import' subcommands, but not 'import' itself.
397 ((and (cdr commands)
398 (string= command "import"))
399 (argument :doc "Package name"))))))
400
401(defvar guix-command-additional-arguments
402 `((("environment")
403 ,(guix-command-make-argument
404 :name "++packages " :char ?p :option? t
405 :doc "build inputs of the specified packages"
406 :fun 'guix-read-package-names-string)))
407 "Alist of guix commands and additional arguments for them.
408These are 'fake' arguments that are not presented in 'guix' shell
409commands.")
410
411(defun guix-command-additional-arguments (&optional commands)
412 "Return additional arguments for COMMANDS."
413 (let ((rest-arg (guix-command-rest-argument commands)))
414 (append (guix-assoc-value guix-command-additional-arguments
415 commands)
416 (and rest-arg (list rest-arg)))))
417
418;; Ideally only `guix-command-arguments' function should exist with the
419;; contents of `guix-command-all-arguments', but we need to make a
420;; special case for `guix-command-complex-with-shared-arguments' commands.
421
422(defun guix-command-all-arguments (&optional commands)
423 "Return list of all arguments for 'guix COMMANDS ...'."
424 (let ((parsed (guix-command-parse-arguments commands)))
425 (append (guix-command-improve-arguments parsed commands)
426 (guix-command-additional-arguments commands))))
427
428(guix-memoized-defalias guix-command-all-arguments-memoize
429 guix-command-all-arguments)
430
431(defun guix-command-arguments (&optional commands)
432 "Return list of arguments for 'guix COMMANDS ...'."
433 (let ((command (car commands)))
434 (if (member command
435 guix-command-complex-with-shared-arguments)
436 ;; Take actions only for 'guix system', and switches+options for
437 ;; 'guix system foo'.
438 (funcall (if (null (cdr commands))
439 #'cl-remove-if-not
440 #'cl-remove-if)
441 #'guix-command-argument-action?
442 (guix-command-all-arguments-memoize (list command)))
443 (guix-command-all-arguments commands))))
444
445(defun guix-command-switch->popup-switch (switch)
446 "Return popup switch from command SWITCH argument."
447 (list (guix-command-argument-char switch)
448 (or (guix-command-argument-doc switch)
449 "Unknown")
450 (guix-command-argument-name switch)))
451
452(defun guix-command-option->popup-option (option)
453 "Return popup option from command OPTION argument."
454 (list (guix-command-argument-char option)
455 (or (guix-command-argument-doc option)
456 "Unknown")
457 (let ((name (guix-command-argument-name option)))
458 (if (string-match-p " \\'" name) ; ends with space
459 name
460 (concat name "=")))
461 (or (guix-command-argument-fun option)
462 'read-from-minibuffer)))
463
464(defun guix-command-action->popup-action (action)
465 "Return popup action from command ACTION argument."
466 (list (guix-command-argument-char action)
467 (or (guix-command-argument-doc action)
468 (guix-command-argument-name action)
469 "Unknown")
470 (guix-command-argument-fun action)))
471
472(defun guix-command-sort-arguments (arguments)
473 "Sort ARGUMENTS by name in alphabetical order."
474 (sort arguments
475 (lambda (a1 a2)
476 (let ((name1 (guix-command-argument-name a1))
477 (name2 (guix-command-argument-name a2)))
478 (cond ((null name1) nil)
479 ((null name2) t)
480 (t (string< name1 name2)))))))
481
482(defun guix-command-switches (arguments)
483 "Return switches from ARGUMENTS."
484 (cl-remove-if-not #'guix-command-argument-switch? arguments))
485
486(defun guix-command-options (arguments)
487 "Return options from ARGUMENTS."
488 (cl-remove-if-not #'guix-command-argument-option? arguments))
489
490(defun guix-command-actions (arguments)
491 "Return actions from ARGUMENTS."
492 (cl-remove-if-not #'guix-command-argument-action? arguments))
493
494
495;;; Post processing popup arguments
496
497(defvar guix-command-post-processors
498 '(("environment"
499 guix-command-post-process-environment-packages
500 guix-command-post-process-environment-ad-hoc
501 guix-command-post-process-rest-multiple-leave)
502 ("hash"
503 guix-command-post-process-rest-single)
504 ("package"
505 guix-command-post-process-package-args)
506 ("system"
507 guix-command-post-process-rest-single))
508 "Alist of guix commands and functions for post-processing
509a list of arguments returned from popup interface.
510Each function is called on the returned arguments in turn.")
511
512(defvar guix-command-rest-arg-regexp
513 (rx string-start "-- " (group (+ any)))
514 "Regexp to match a string with the 'rest' arguments.")
515
516(defun guix-command-replace-args (args predicate modifier)
517 "Replace arguments matching PREDICATE from ARGS.
518Call MODIFIER on each argument matching PREDICATE and append the
519returned list of strings to the end of ARGS. Remove the original
520arguments."
521 (let* ((rest nil)
522 (args (mapcar (lambda (arg)
523 (if (funcall predicate arg)
524 (progn
525 (push (funcall modifier arg) rest)
526 nil)
527 arg))
528 args)))
529 (if rest
530 (apply #'append (delq nil args) rest)
531 args)))
532
533(cl-defun guix-command-post-process-matching-args (args regexp
534 &key group split?)
535 "Modify arguments from ARGS matching REGEXP by moving them to
536the end of ARGS list. If SPLIT? is non-nil, split matching
537arguments into multiple subarguments."
538 (guix-command-replace-args
539 args
540 (lambda (arg)
541 (string-match regexp arg))
542 (lambda (arg)
543 (let ((val (match-string (or group 0) arg))
544 (fun (if split? #'split-string #'list)))
545 (funcall fun val)))))
546
547(defun guix-command-post-process-rest-single (args)
548 "Modify ARGS by moving '-- ARG' argument to the end of ARGS list."
549 (guix-command-post-process-matching-args
550 args guix-command-rest-arg-regexp
551 :group 1))
552
553(defun guix-command-post-process-rest-multiple (args)
554 "Modify ARGS by splitting '-- ARG ...' into multiple subarguments
555and moving them to the end of ARGS list.
556Remove '-- ' string."
557 (guix-command-post-process-matching-args
558 args guix-command-rest-arg-regexp
559 :group 1
560 :split? t))
561
562(defun guix-command-post-process-rest-multiple-leave (args)
563 "Modify ARGS by splitting '-- ARG ...' into multiple subarguments
564and moving them to the end of ARGS list.
565Leave '--' string as a separate argument."
566 (guix-command-post-process-matching-args
567 args guix-command-rest-arg-regexp
568 :split? t))
569
570(defun guix-command-post-process-package-args (args)
571 "Adjust popup ARGS for 'guix package' command."
572 (guix-command-post-process-matching-args
573 args (rx string-start (or "--install " "--remove ") (+ any))
574 :split? t))
575
576(defun guix-command-post-process-environment-packages (args)
577 "Adjust popup ARGS for specified packages of 'guix environment'
578command."
579 (guix-command-post-process-matching-args
580 args (rx string-start "++packages " (group (+ any)))
581 :group 1
582 :split? t))
583
584(defun guix-command-post-process-environment-ad-hoc (args)
585 "Adjust popup ARGS for '--ad-hoc' argument of 'guix environment'
586command."
587 (guix-command-post-process-matching-args
588 args (rx string-start "--ad-hoc " (+ any))
589 :split? t))
590
591(defun guix-command-post-process-args (commands args)
592 "Adjust popup ARGS for guix COMMANDS."
593 (let* ((command (car commands))
594 (processors
595 (append (guix-assoc-value guix-command-post-processors commands)
596 (guix-assoc-value guix-command-post-processors command))))
597 (guix-modify args
598 (or processors
599 (list #'guix-command-post-process-rest-multiple)))))
600
601
602;;; 'Execute' actions
603
604(defvar guix-command-default-execute-arguments
605 (list
606 (guix-command-make-argument
607 :name "repl" :char ?r :doc "Run in Guix REPL")
608 (guix-command-make-argument
609 :name "shell" :char ?s :doc "Run in shell")
610 (guix-command-make-argument
611 :name "copy" :char ?c :doc "Copy command line"))
612 "List of default 'execute' action arguments.")
613
614(defvar guix-command-additional-execute-arguments
615 (let ((graph-arg (guix-command-make-argument
616 :name "view" :char ?v :doc "View graph")))
617 `((("build")
618 ,(guix-command-make-argument
619 :name "log" :char ?l :doc "View build log"))
620 (("graph") ,graph-arg)
621 (("size")
622 ,(guix-command-make-argument
623 :name "view" :char ?v :doc "View map"))
624 (("system" "shepherd-graph") ,graph-arg)
625 (("system" "extension-graph") ,graph-arg)))
626 "Alist of guix commands and additional 'execute' action arguments.")
627
628(defun guix-command-execute-arguments (commands)
629 "Return a list of 'execute' action arguments for COMMANDS."
630 (mapcar (lambda (arg)
631 (guix-command-modify-argument arg
632 :action? t
633 :fun (guix-command-action-name
634 commands (guix-command-argument-name arg))))
635 (append guix-command-default-execute-arguments
636 (guix-assoc-value
637 guix-command-additional-execute-arguments commands))))
638
639(defvar guix-command-special-executors
640 '((("environment")
641 ("repl" . guix-run-environment-command-in-repl))
642 (("pull")
643 ("repl" . guix-run-pull-command-in-repl))
644 (("build")
645 ("log" . guix-run-view-build-log))
646 (("graph")
647 ("view" . guix-run-view-graph))
648 (("size")
649 ("view" . guix-run-view-size-map))
650 (("system" "shepherd-graph")
651 ("view" . guix-run-view-graph))
652 (("system" "extension-graph")
653 ("view" . guix-run-view-graph)))
654 "Alist of guix commands and alists of special executers for them.
655See also `guix-command-default-executors'.")
656
657(defvar guix-command-default-executors
658 '(("repl" . guix-run-command-in-repl)
659 ("shell" . guix-run-command-in-shell)
660 ("copy" . guix-copy-command-as-kill))
661 "Alist of default executers for action names.")
662
663(defun guix-command-executor (commands name)
664 "Return function to run command line arguments for guix COMMANDS."
665 (or (guix-assoc-value guix-command-special-executors commands name)
666 (guix-assoc-value guix-command-default-executors name)))
667
668(defun guix-run-environment-command-in-repl (args)
669 "Run 'guix ARGS ...' environment command in Guix REPL."
670 ;; As 'guix environment' usually tries to run another process, it may
671 ;; be fun but not wise to run this command in Geiser REPL.
672 (when (or (member "--dry-run" args)
673 (member "--search-paths" args)
674 (when (y-or-n-p
675 (format "'%s' command will spawn an external process.
676Do you really want to execute this command in Geiser REPL? "
677 (guix-command-string args)))
678 (message "May \"M-x shell-mode\" be with you!")
679 t))
680 (guix-run-command-in-repl args)))
681
682(defun guix-run-pull-command-in-repl (args)
683 "Run 'guix ARGS ...' pull command in Guix REPL.
684Perform pull-specific actions after operation, see
685`guix-after-pull-hook' and `guix-update-after-pull'."
686 (guix-eval-in-repl
687 (apply #'guix-make-guile-expression 'guix-command args)
688 nil 'pull))
689
690(defun guix-run-view-build-log (args)
691 "Add --log-file to ARGS, run 'guix ARGS ...' build command, and
692open the log file(s)."
693 (let* ((args (if (member "--log-file" args)
694 args
695 (cl-list* (car args) "--log-file" (cdr args))))
696 (output (guix-command-output args))
697 (files (split-string output "\n" t)))
698 (dolist (file files)
699 (guix-build-log-find-file file))))
700
701(defun guix-run-view-graph (args)
702 "Run 'guix ARGS ...' graph command, make the image and open it."
703 (let* ((graph-file (guix-dot-file-name))
704 (dot-args (guix-dot-arguments graph-file)))
705 (if (guix-eval-read (guix-make-guile-expression
706 'pipe-guix-output args dot-args))
707 (guix-find-file graph-file)
708 (error "Couldn't create a graph"))))
709
710(defun guix-run-view-size-map (args)
711 "Run 'guix ARGS ...' size command, and open the map file."
712 (let* ((wished-map-file
713 (cl-some (lambda (arg)
714 (and (string-match "--map-file=\\(.+\\)" arg)
715 (match-string 1 arg)))
716 args))
717 (map-file (or wished-map-file (guix-png-file-name)))
718 (args (if wished-map-file
719 args
720 (cl-list* (car args)
721 (concat "--map-file=" map-file)
722 (cdr args)))))
723 (guix-command-output args)
724 (guix-find-file map-file)))
725
726
727;;; Generating popups, actions, etc.
728
729(defmacro guix-command-define-popup-action (name &optional commands)
730 "Define NAME function to generate (if needed) and run popup for COMMANDS."
731 (declare (indent 1) (debug t))
732 (let* ((popup-fun (guix-command-symbol `(,@commands "popup")))
733 (doc (format "Call `%s' (generate it if needed)."
734 popup-fun)))
735 `(defun ,name (&optional arg)
736 ,doc
737 (interactive "P")
738 (unless (fboundp ',popup-fun)
739 (guix-command-generate-popup ',popup-fun ',commands))
740 (,popup-fun arg))))
741
742(defmacro guix-command-define-execute-action (name executor
743 &optional commands)
744 "Define NAME function to execute the current action for guix COMMANDS.
745EXECUTOR function is called with the current command line arguments."
746 (declare (indent 1) (debug t))
747 (let* ((arguments-fun (guix-command-symbol `(,@commands "arguments")))
748 (doc (format "Call `%s' with the current popup arguments."
749 executor)))
750 `(defun ,name (&rest args)
751 ,doc
752 (interactive (,arguments-fun))
753 (,executor (append ',commands
754 (guix-command-post-process-args
755 ',commands args))))))
756
757(defun guix-command-generate-popup-actions (actions &optional commands)
758 "Generate 'popup' commands from ACTIONS arguments for guix COMMANDS."
759 (dolist (action actions)
760 (let ((fun (guix-command-argument-fun action)))
761 (unless (fboundp fun)
762 (eval `(guix-command-define-popup-action ,fun
763 ,(append commands
764 (list (guix-command-argument-name action)))))))))
765
766(defun guix-command-generate-execute-actions (actions &optional commands)
767 "Generate 'execute' commands from ACTIONS arguments for guix COMMANDS."
768 (dolist (action actions)
769 (let ((fun (guix-command-argument-fun action)))
770 (unless (fboundp fun)
771 (eval `(guix-command-define-execute-action ,fun
772 ,(guix-command-executor
773 commands (guix-command-argument-name action))
774 ,commands))))))
775
776(defun guix-command-generate-popup (name &optional commands)
777 "Define NAME popup with 'guix COMMANDS ...' interface."
778 (let* ((command (car commands))
779 (man-page (concat "guix" (and command (concat "-" command))))
780 (doc (format "Popup window for '%s' command."
781 (guix-concat-strings (cons "guix" commands)
782 " ")))
783 (args (guix-command-arguments commands))
784 (switches (guix-command-sort-arguments
785 (guix-command-switches args)))
786 (options (guix-command-sort-arguments
787 (guix-command-options args)))
788 (popup-actions (guix-command-sort-arguments
789 (guix-command-actions args)))
790 (execute-actions (unless popup-actions
791 (guix-command-execute-arguments commands)))
792 (actions (or popup-actions execute-actions)))
793 (if popup-actions
794 (guix-command-generate-popup-actions popup-actions commands)
795 (guix-command-generate-execute-actions execute-actions commands))
796 (eval
797 `(guix-define-popup ,name
798 ,doc
799 'guix-commands
800 :man-page ,man-page
801 :switches ',(mapcar #'guix-command-switch->popup-switch switches)
802 :options ',(mapcar #'guix-command-option->popup-option options)
803 :actions ',(mapcar #'guix-command-action->popup-action actions)
804 :max-action-columns 4))))
805
806;;;###autoload (autoload 'guix "guix-command" "Popup window for 'guix'." t)
807(guix-command-define-popup-action guix)
808
809(defalias 'guix-edit-action #'guix-edit)
810
811
812(defvar guix-command-font-lock-keywords
813 (eval-when-compile
814 `((,(rx "("
815 (group "guix-command-define-"
816 (or "popup-action"
817 "execute-action"
818 "argument-improver"))
819 symbol-end
820 (zero-or-more blank)
821 (zero-or-one
822 (group (one-or-more (or (syntax word) (syntax symbol))))))
823 (1 font-lock-keyword-face)
824 (2 font-lock-function-name-face nil t)))))
825
826(font-lock-add-keywords 'emacs-lisp-mode guix-command-font-lock-keywords)
827
828(provide 'guix-command)
829
830;;; guix-command.el ends here
diff --git a/emacs/guix-config.el.in b/emacs/guix-config.el.in
deleted file mode 100644
index c09c2fe86a8..00000000000
--- a/emacs/guix-config.el.in
+++ /dev/null
@@ -1,44 +0,0 @@
1;;; guix-config.el --- Compile-time configuration of Guix.
2
3;; Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org>
4;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
5
6;; This file is part of GNU Guix.
7
8;; GNU Guix is free software; you can redistribute it and/or modify
9;; it under the terms of the GNU General Public License as published by
10;; the Free Software Foundation, either version 3 of the License, or
11;; (at your option) any later version.
12
13;; GNU Guix is distributed in the hope that it will be useful,
14;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16;; GNU General Public License for more details.
17
18;; You should have received a copy of the GNU General Public License
19;; along with this program. If not, see <http://www.gnu.org/licenses/>.
20
21;;; Code:
22
23(defconst guix-config-name "@PACKAGE_NAME@"
24 "Guix full name.")
25
26(defconst guix-config-version "@PACKAGE_VERSION@"
27 "Guix version.")
28
29(defconst guix-config-emacs-interface-directory
30 (replace-regexp-in-string "${prefix}" "@prefix@" "@emacsuidir@"))
31
32(defconst guix-config-state-directory
33 ;; This must match `NIX_STATE_DIR' as defined in `nix/local.mk'.
34 (or (getenv "NIX_STATE_DIR") "@guix_localstatedir@/guix"))
35
36(defconst guix-config-guile-program "@GUILE@"
37 "Name of the 'guile' executable defined at configure time.")
38
39(defconst guix-config-dot-program "@DOT_USER_PROGRAM@"
40 "Name of the 'dot' executable defined at configure time.")
41
42(provide 'guix-config)
43
44;;; guix-config.el ends here
diff --git a/emacs/guix-devel.el b/emacs/guix-devel.el
deleted file mode 100644
index b71670cdfba..00000000000
--- a/emacs/guix-devel.el
+++ /dev/null
@@ -1,382 +0,0 @@
1;;; guix-devel.el --- Development tools -*- lexical-binding: t -*-
2
3;; Copyright © 2015 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 commands useful for developing Guix (or even
23;; arbitrary Guile code) with Geiser.
24
25;;; Code:
26
27(require 'lisp-mode)
28(require 'guix-guile)
29(require 'guix-geiser)
30(require 'guix-utils)
31(require 'guix-base)
32
33(defgroup guix-devel nil
34 "Settings for Guix development utils."
35 :group 'guix)
36
37(defgroup guix-devel-faces nil
38 "Faces for `guix-devel-mode'."
39 :group 'guix-devel
40 :group 'guix-faces)
41
42(defface guix-devel-modify-phases-keyword
43 '((t :inherit font-lock-preprocessor-face))
44 "Face for a `modify-phases' keyword ('delete', 'replace', etc.)."
45 :group 'guix-devel-faces)
46
47(defface guix-devel-gexp-symbol
48 '((t :inherit font-lock-keyword-face))
49 "Face for gexp symbols ('#~', '#$', etc.).
50See Info node `(guix) G-Expressions'."
51 :group 'guix-devel-faces)
52
53(defcustom guix-devel-activate-mode t
54 "If non-nil, then `guix-devel-mode' is automatically activated
55in Scheme buffers."
56 :type 'boolean
57 :group 'guix-devel)
58
59(defun guix-devel-use-modules (&rest modules)
60 "Use guile MODULES."
61 (apply #'guix-geiser-call "use-modules" modules))
62
63(defun guix-devel-use-module (&optional module)
64 "Use guile MODULE in the current Geiser REPL.
65MODULE is a string with the module name - e.g., \"(ice-9 match)\".
66Interactively, use the module defined by the current scheme file."
67 (interactive (list (guix-guile-current-module)))
68 (guix-devel-use-modules module)
69 (message "Using %s module." module))
70
71(defun guix-devel-copy-module-as-kill ()
72 "Put the name of the current guile module into `kill-ring'."
73 (interactive)
74 (guix-copy-as-kill (guix-guile-current-module)))
75
76(defun guix-devel-setup-repl (&optional repl)
77 "Setup REPL for using `guix-devel-...' commands."
78 (guix-devel-use-modules "(guix monad-repl)"
79 "(guix scripts)"
80 "(guix store)"
81 "(guix ui)")
82 ;; Without this workaround, the warning/build output disappears. See
83 ;; <https://github.com/jaor/geiser/issues/83> for details.
84 (guix-geiser-eval-in-repl-synchronously
85 "(begin
86 (guix-warning-port (current-warning-port))
87 (current-build-output-port (current-error-port)))"
88 repl 'no-history 'no-display))
89
90(defvar guix-devel-repl-processes nil
91 "List of REPL processes configured by `guix-devel-setup-repl'.")
92
93(defun guix-devel-setup-repl-maybe (&optional repl)
94 "Setup (if needed) REPL for using `guix-devel-...' commands."
95 (let ((process (get-buffer-process (or repl (guix-geiser-repl)))))
96 (when (and process
97 (not (memq process guix-devel-repl-processes)))
98 (guix-devel-setup-repl repl)
99 (push process guix-devel-repl-processes))))
100
101(defmacro guix-devel-with-definition (def-var &rest body)
102 "Run BODY with the current guile definition bound to DEF-VAR.
103Bind DEF-VAR variable to the name of the current top-level
104definition, setup the current REPL, use the current module, and
105run BODY."
106 (declare (indent 1) (debug (symbolp body)))
107 `(let ((,def-var (guix-guile-current-definition)))
108 (guix-devel-setup-repl-maybe)
109 (guix-devel-use-modules (guix-guile-current-module))
110 ,@body))
111
112(defun guix-devel-build-package-definition ()
113 "Build a package defined by the current top-level variable definition."
114 (interactive)
115 (guix-devel-with-definition def
116 (when (or (not guix-operation-confirm)
117 (guix-operation-prompt (format "Build '%s'?" def)))
118 (guix-geiser-eval-in-repl
119 (concat ",run-in-store "
120 (guix-guile-make-call-expression
121 "build-package" def
122 "#:use-substitutes?" (guix-guile-boolean
123 guix-use-substitutes)
124 "#:dry-run?" (guix-guile-boolean guix-dry-run)))))))
125
126(defun guix-devel-build-package-source ()
127 "Build the source of the current package definition."
128 (interactive)
129 (guix-devel-with-definition def
130 (when (or (not guix-operation-confirm)
131 (guix-operation-prompt
132 (format "Build '%s' package source?" def)))
133 (guix-geiser-eval-in-repl
134 (concat ",run-in-store "
135 (guix-guile-make-call-expression
136 "build-package-source" def
137 "#:use-substitutes?" (guix-guile-boolean
138 guix-use-substitutes)
139 "#:dry-run?" (guix-guile-boolean guix-dry-run)))))))
140
141(defun guix-devel-lint-package ()
142 "Check the current package.
143See Info node `(guix) Invoking guix lint' for details."
144 (interactive)
145 (guix-devel-with-definition def
146 (guix-devel-use-modules "(guix scripts lint)")
147 (when (or (not guix-operation-confirm)
148 (y-or-n-p (format "Lint '%s' package?" def)))
149 (guix-geiser-eval-in-repl
150 (format "(run-checkers %s)" def)))))
151
152
153;;; Font-lock
154
155(defvar guix-devel-modify-phases-keyword-regexp
156 (rx (+ word))
157 "Regexp for a 'modify-phases' keyword ('delete', 'replace', etc.).")
158
159(defun guix-devel-modify-phases-font-lock-matcher (limit)
160 "Find a 'modify-phases' keyword.
161This function is used as a MATCHER for `font-lock-keywords'."
162 (ignore-errors
163 (down-list)
164 (or (re-search-forward guix-devel-modify-phases-keyword-regexp
165 limit t)
166 (set-match-data nil))
167 (up-list)
168 t))
169
170(defun guix-devel-modify-phases-font-lock-pre ()
171 "Skip the next sexp, and return the end point of the current list.
172This function is used as a PRE-MATCH-FORM for `font-lock-keywords'
173to find 'modify-phases' keywords."
174 (let ((in-comment? (nth 4 (syntax-ppss))))
175 ;; If 'modify-phases' is commented, do not try to search for its
176 ;; keywords.
177 (unless in-comment?
178 (ignore-errors (forward-sexp))
179 (save-excursion (up-list) (point)))))
180
181(defconst guix-devel-keywords
182 '("call-with-compressed-output-port"
183 "call-with-container"
184 "call-with-decompressed-port"
185 "call-with-derivation-narinfo"
186 "call-with-derivation-substitute"
187 "call-with-error-handling"
188 "call-with-temporary-directory"
189 "call-with-temporary-output-file"
190 "define-enumerate-type"
191 "define-gexp-compiler"
192 "define-lift"
193 "define-monad"
194 "define-operation"
195 "define-record-type*"
196 "emacs-substitute-sexps"
197 "emacs-substitute-variables"
198 "mbegin"
199 "mlet"
200 "mlet*"
201 "modify-services"
202 "munless"
203 "mwhen"
204 "run-with-state"
205 "run-with-store"
206 "signature-case"
207 "substitute*"
208 "substitute-keyword-arguments"
209 "test-assertm"
210 "use-package-modules"
211 "use-service-modules"
212 "use-system-modules"
213 "with-atomic-file-output"
214 "with-atomic-file-replacement"
215 "with-derivation-narinfo"
216 "with-derivation-substitute"
217 "with-directory-excursion"
218 "with-error-handling"
219 "with-imported-modules"
220 "with-monad"
221 "with-mutex"
222 "with-store"))
223
224(defvar guix-devel-font-lock-keywords
225 `((,(rx (or "#~" "#$" "#$@" "#+" "#+@")) .
226 'guix-devel-gexp-symbol)
227 (,(guix-guile-keyword-regexp (regexp-opt guix-devel-keywords))
228 (1 'font-lock-keyword-face))
229 (,(guix-guile-keyword-regexp "modify-phases")
230 (1 'font-lock-keyword-face)
231 (guix-devel-modify-phases-font-lock-matcher
232 (guix-devel-modify-phases-font-lock-pre)
233 nil
234 (0 'guix-devel-modify-phases-keyword nil t))))
235 "A list of `font-lock-keywords' for `guix-devel-mode'.")
236
237
238;;; Indentation
239
240(defmacro guix-devel-scheme-indent (&rest rules)
241 "Set `scheme-indent-function' according to RULES.
242Each rule should have a form (SYMBOL VALUE). See `put' for details."
243 (declare (indent 0))
244 `(progn
245 ,@(mapcar (lambda (rule)
246 `(put ',(car rule) 'scheme-indent-function ,(cadr rule)))
247 rules)))
248
249(defun guix-devel-indent-package (state indent-point normal-indent)
250 "Indentation rule for 'package' form."
251 (let* ((package-eol (line-end-position))
252 (count (if (and (ignore-errors (down-list) t)
253 (< (point) package-eol)
254 (looking-at "inherit\\>"))
255 1
256 0)))
257 (lisp-indent-specform count state indent-point normal-indent)))
258
259(defun guix-devel-indent-modify-phases-keyword (count)
260 "Return indentation function for 'modify-phases' keywords."
261 (lambda (state indent-point normal-indent)
262 (when (ignore-errors
263 (goto-char (nth 1 state)) ; start of keyword sexp
264 (backward-up-list)
265 (looking-at "(modify-phases\\>"))
266 (lisp-indent-specform count state indent-point normal-indent))))
267
268(defalias 'guix-devel-indent-modify-phases-keyword-1
269 (guix-devel-indent-modify-phases-keyword 1))
270(defalias 'guix-devel-indent-modify-phases-keyword-2
271 (guix-devel-indent-modify-phases-keyword 2))
272
273(guix-devel-scheme-indent
274 (bag 0)
275 (build-system 0)
276 (call-with-compressed-output-port 2)
277 (call-with-container 1)
278 (call-with-decompressed-port 2)
279 (call-with-error-handling 0)
280 (container-excursion 1)
281 (emacs-batch-edit-file 1)
282 (emacs-batch-eval 0)
283 (emacs-substitute-sexps 1)
284 (emacs-substitute-variables 1)
285 (file-system 0)
286 (graft 0)
287 (manifest-entry 0)
288 (manifest-pattern 0)
289 (mbegin 1)
290 (mlet 2)
291 (mlet* 2)
292 (modify-phases 1)
293 (modify-services 1)
294 (munless 1)
295 (mwhen 1)
296 (operating-system 0)
297 (origin 0)
298 (package 'guix-devel-indent-package)
299 (run-with-state 1)
300 (run-with-store 1)
301 (signature-case 1)
302 (substitute* 1)
303 (substitute-keyword-arguments 1)
304 (test-assertm 1)
305 (with-atomic-file-output 1)
306 (with-derivation-narinfo 1)
307 (with-derivation-substitute 2)
308 (with-directory-excursion 1)
309 (with-error-handling 0)
310 (with-imported-modules 1)
311 (with-monad 1)
312 (with-mutex 1)
313 (with-store 1)
314 (wrap-program 1)
315
316 ;; 'modify-phases' keywords:
317 (replace 'guix-devel-indent-modify-phases-keyword-1)
318 (add-after 'guix-devel-indent-modify-phases-keyword-2)
319 (add-before 'guix-devel-indent-modify-phases-keyword-2))
320
321
322(defvar guix-devel-keys-map
323 (let ((map (make-sparse-keymap)))
324 (define-key map (kbd "b") 'guix-devel-build-package-definition)
325 (define-key map (kbd "s") 'guix-devel-build-package-source)
326 (define-key map (kbd "l") 'guix-devel-lint-package)
327 (define-key map (kbd "k") 'guix-devel-copy-module-as-kill)
328 (define-key map (kbd "u") 'guix-devel-use-module)
329 map)
330 "Keymap with subkeys for `guix-devel-mode-map'.")
331
332(defvar guix-devel-mode-map
333 (let ((map (make-sparse-keymap)))
334 (define-key map (kbd "C-c .") guix-devel-keys-map)
335 map)
336 "Keymap for `guix-devel-mode'.")
337
338;;;###autoload
339(define-minor-mode guix-devel-mode
340 "Minor mode for `scheme-mode' buffers.
341
342With a prefix argument ARG, enable the mode if ARG is positive,
343and disable it otherwise. If called from Lisp, enable the mode
344if ARG is omitted or nil.
345
346When Guix Devel mode is enabled, it provides the following key
347bindings:
348
349\\{guix-devel-mode-map}"
350 :init-value nil
351 :lighter " Guix"
352 :keymap guix-devel-mode-map
353 (if guix-devel-mode
354 (progn
355 (setq-local font-lock-multiline t)
356 (font-lock-add-keywords nil guix-devel-font-lock-keywords))
357 (setq-local font-lock-multiline nil)
358 (font-lock-remove-keywords nil guix-devel-font-lock-keywords))
359 (when font-lock-mode
360 (font-lock-fontify-buffer)))
361
362;;;###autoload
363(defun guix-devel-activate-mode-maybe ()
364 "Activate `guix-devel-mode' depending on
365`guix-devel-activate-mode' variable."
366 (when guix-devel-activate-mode
367 (guix-devel-mode)))
368
369;;;###autoload
370(add-hook 'scheme-mode-hook 'guix-devel-activate-mode-maybe)
371
372
373(defvar guix-devel-emacs-font-lock-keywords
374 (eval-when-compile
375 `((,(rx "(" (group "guix-devel-with-definition") symbol-end) . 1))))
376
377(font-lock-add-keywords 'emacs-lisp-mode
378 guix-devel-emacs-font-lock-keywords)
379
380(provide 'guix-devel)
381
382;;; guix-devel.el ends here
diff --git a/emacs/guix-entry.el b/emacs/guix-entry.el
deleted file mode 100644
index 5eed2ed0155..00000000000
--- a/emacs/guix-entry.el
+++ /dev/null
@@ -1,59 +0,0 @@
1;;; guix-entry.el --- 'Entry' type -*- lexical-binding: t -*-
2
3;; Copyright © 2015 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 an API for 'entry' type which is just an alist of
23;; KEY/VALUE pairs (KEY should be a symbol) with the required 'id' KEY.
24
25;;; Code:
26
27(require 'cl-lib)
28(require 'guix-utils)
29
30(defalias 'guix-entry-value #'guix-assq-value)
31
32(defun guix-entry-id (entry)
33 "Return ENTRY ID."
34 (guix-entry-value entry 'id))
35
36(defun guix-entry-by-id (id entries)
37 "Return an entry from ENTRIES by its ID."
38 (cl-find-if (lambda (entry)
39 (equal (guix-entry-id entry) id))
40 entries))
41
42(defun guix-entries-by-ids (ids entries)
43 "Return entries with IDS (a list of identifiers) from ENTRIES."
44 (cl-remove-if-not (lambda (entry)
45 (member (guix-entry-id entry) ids))
46 entries))
47
48(defun guix-replace-entry (id new-entry entries)
49 "Replace an entry with ID from ENTRIES by NEW-ENTRY.
50Return a list of entries with the replaced entry."
51 (cl-substitute-if new-entry
52 (lambda (entry)
53 (equal id (guix-entry-id entry)))
54 entries
55 :count 1))
56
57(provide 'guix-entry)
58
59;;; guix-entry.el ends here
diff --git a/emacs/guix-external.el b/emacs/guix-external.el
deleted file mode 100644
index f571ffd8450..00000000000
--- a/emacs/guix-external.el
+++ /dev/null
@@ -1,88 +0,0 @@
1;;; guix-external.el --- External programs -*- lexical-binding: t -*-
2
3;; Copyright © 2015 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 code for running external programs.
23
24;;; Code:
25
26(require 'cl-lib)
27(require 'guix-config)
28
29(defgroup guix-external nil
30 "Settings for external programs."
31 :group 'guix)
32
33(defcustom guix-guile-program guix-config-guile-program
34 "Name of the 'guile' executable used for Guix REPL.
35May be either a string (the name of the executable) or a list of
36strings of the form:
37
38 (NAME . ARGS)
39
40Where ARGS is a list of arguments to the guile program."
41 :type 'string
42 :group 'guix-external)
43
44(defcustom guix-dot-program
45 (if (file-name-absolute-p guix-config-dot-program)
46 guix-config-dot-program
47 (executable-find "dot"))
48 "Name of the 'dot' executable."
49 :type 'string
50 :group 'guix-external)
51
52(defcustom guix-dot-default-arguments
53 '("-Tpng")
54 "Default arguments for 'dot' program."
55 :type '(repeat string)
56 :group 'guix-external)
57
58(defcustom guix-dot-file-name-function #'guix-png-file-name
59 "Function used to define a file name of a temporary 'dot' file.
60The function is called without arguments."
61 :type '(choice (function-item guix-png-file-name)
62 (function :tag "Other function"))
63 :group 'guix-external)
64
65(defun guix-dot-arguments (output-file &rest args)
66 "Return a list of dot arguments for writing a graph into OUTPUT-FILE.
67If ARGS is nil, use `guix-dot-default-arguments'."
68 (or guix-dot-program
69 (error (concat "Couldn't find 'dot'.\n"
70 "Set guix-dot-program to a proper value")))
71 (cl-list* guix-dot-program
72 (concat "-o" output-file)
73 (or args guix-dot-default-arguments)))
74
75(defun guix-dot-file-name ()
76 "Call `guix-dot-file-name-function'."
77 (funcall guix-dot-file-name-function))
78
79(defun guix-png-file-name ()
80 "Return '.png' file name in the `temporary-file-directory'."
81 (concat (make-temp-name
82 (concat (file-name-as-directory temporary-file-directory)
83 "guix-emacs-graph-"))
84 ".png"))
85
86(provide 'guix-external)
87
88;;; guix-external.el ends here
diff --git a/emacs/guix-geiser.el b/emacs/guix-geiser.el
deleted file mode 100644
index 833f5bb2b3c..00000000000
--- a/emacs/guix-geiser.el
+++ /dev/null
@@ -1,126 +0,0 @@
1;;; guix-geiser.el --- Interacting with Geiser -*- lexical-binding: t -*-
2
3;; Copyright © 2015 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 functions to evaluate guile code using Geiser.
23
24;;; Code:
25
26(require 'geiser-mode)
27(require 'guix-guile)
28
29(defun guix-geiser-repl ()
30 "Return the current Geiser REPL."
31 (or geiser-repl--repl
32 (geiser-repl--repl/impl 'guile)
33 (error "Geiser REPL not found")))
34
35(defun guix-geiser-eval (str &optional repl)
36 "Evaluate STR with guile expression using Geiser REPL.
37If REPL is nil, use the current Geiser REPL.
38Return a list of strings with result values of evaluation."
39 (with-current-buffer (or repl (guix-geiser-repl))
40 (let ((res (geiser-eval--send/wait `(:eval (:scm ,str)))))
41 (if (geiser-eval--retort-error res)
42 (error "Error in evaluating guile expression: %s"
43 (geiser-eval--retort-output res))
44 (cdr (assq 'result res))))))
45
46(defun guix-geiser-eval-read (str &optional repl)
47 "Evaluate STR with guile expression using Geiser REPL.
48Return elisp expression of the first result value of evaluation."
49 ;; The goal is to convert a string with scheme expression into elisp
50 ;; expression.
51 (let ((result (car (guix-geiser-eval str repl))))
52 (cond
53 ((or (string= result "#f")
54 (string= result "#<unspecified>"))
55 nil)
56 ((string= result "#t")
57 t)
58 (t
59 (read (replace-regexp-in-string
60 "[ (]\\(#f\\)" "nil"
61 (replace-regexp-in-string
62 "[ (]\\(#t\\)" "t"
63 result
64 nil nil 1)
65 nil nil 1))))))
66
67(defun guix-repl-send (cmd &optional save-history)
68 "Send CMD input string to the current REPL buffer.
69This is the same as `geiser-repl--send', but with SAVE-HISTORY
70argument. If SAVE-HISTORY is non-nil, save CMD in the REPL
71history."
72 (when (and cmd (eq major-mode 'geiser-repl-mode))
73 (geiser-repl--prepare-send)
74 (goto-char (point-max))
75 (comint-kill-input)
76 (insert cmd)
77 (let ((comint-input-filter (if save-history
78 comint-input-filter
79 'ignore)))
80 (comint-send-input nil t))))
81
82(defun guix-geiser-eval-in-repl (str &optional repl no-history no-display)
83 "Switch to Geiser REPL and evaluate STR with guile expression there.
84If NO-HISTORY is non-nil, do not save STR in the REPL history.
85If NO-DISPLAY is non-nil, do not switch to the REPL buffer."
86 (let ((repl (or repl (guix-geiser-repl))))
87 (with-current-buffer repl
88 ;; XXX Since Geiser 0.8, `geiser-repl--send' has SAVE-HISTORY
89 ;; argument, so use this function eventually and remove
90 ;; `guix-repl-send'.
91 (guix-repl-send str (not no-history)))
92 (unless no-display
93 (geiser-repl--switch-to-buffer repl))))
94
95(defun guix-geiser-eval-in-repl-synchronously (str &optional repl
96 no-history no-display)
97 "Evaluate STR in Geiser REPL synchronously, i.e. wait until the
98REPL operation will be finished.
99See `guix-geiser-eval-in-repl' for the meaning of arguments."
100 (let* ((repl (if repl (get-buffer repl) (guix-geiser-repl)))
101 (running? nil)
102 (filter (lambda (output)
103 (setq running?
104 (and (get-buffer-process repl)
105 (not (guix-guile-prompt? output))))))
106 (comint-output-filter-functions
107 (cons filter comint-output-filter-functions)))
108 (guix-geiser-eval-in-repl str repl no-history no-display)
109 (while running?
110 (sleep-for 0.1))))
111
112(defun guix-geiser-call (proc &rest args)
113 "Call (PROC ARGS ...) synchronously using the current Geiser REPL.
114PROC and ARGS should be strings."
115 (guix-geiser-eval
116 (apply #'guix-guile-make-call-expression proc args)))
117
118(defun guix-geiser-call-in-repl (proc &rest args)
119 "Call (PROC ARGS ...) in the current Geiser REPL.
120PROC and ARGS should be strings."
121 (guix-geiser-eval-in-repl
122 (apply #'guix-guile-make-call-expression proc args)))
123
124(provide 'guix-geiser)
125
126;;; guix-geiser.el ends here
diff --git a/emacs/guix-guile.el b/emacs/guix-guile.el
deleted file mode 100644
index 792f825ca58..00000000000
--- a/emacs/guix-guile.el
+++ /dev/null
@@ -1,98 +0,0 @@
1;;; guix-guile.el --- Auxiliary tools for working with guile code -*- lexical-binding: t -*-
2
3;; Copyright © 2015 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 functions for parsing guile code, making guile
23;; expressions, etc.
24
25;;; Code:
26
27(require 'geiser-guile)
28
29(defvar guix-guile-definition-regexp
30 (rx bol "(define"
31 (zero-or-one "*")
32 (zero-or-one "-public")
33 (one-or-more space)
34 (zero-or-one "(")
35 (group (one-or-more (or word (syntax symbol)))))
36 "Regexp used to find the guile definition.")
37
38(defun guix-guile-current-definition ()
39 "Return string with name of the current top-level guile definition."
40 (save-excursion
41 (beginning-of-defun)
42 (if (looking-at guix-guile-definition-regexp)
43 (match-string-no-properties 1)
44 (error "Couldn't find the current definition"))))
45
46(defun guix-guile-current-module ()
47 "Return a string with the current guile module.
48Return nil, if current buffer does not define a module."
49 ;; Modified version of `geiser-guile--get-module'.
50 (save-excursion
51 (geiser-syntax--pop-to-top)
52 (when (or (re-search-backward geiser-guile--module-re nil t)
53 (looking-at geiser-guile--library-re)
54 (re-search-forward geiser-guile--module-re nil t))
55 (match-string-no-properties 1))))
56
57(defun guix-guile-boolean (arg)
58 "Return a string with guile boolean value.
59Transform elisp ARG (nil or non-nil) to the guile boolean (#f or #t)."
60 (if arg "#t" "#f"))
61
62(defun guix-guile-keyword-regexp (keyword)
63 "Return regexp to find guile KEYWORD."
64 (format "(\\(%s\\)\\_>" keyword))
65
66(defun guix-guile-make-call-expression (proc &rest args)
67 "Return \"(PROC ARGS ...)\" string.
68PROC and ARGS should be strings."
69 (format "(%s %s)"
70 proc
71 (mapconcat #'identity args " ")))
72
73(defun guix-make-guile-expression (fun &rest args)
74 "Return string containing a guile expression for calling FUN with ARGS."
75 (format "(%S %s)" fun
76 (mapconcat
77 (lambda (arg)
78 (cond
79 ((null arg) "'()")
80 ((or (eq arg t)
81 ;; An ugly hack to separate 'false' from nil.
82 (equal arg 'f)
83 (keywordp arg))
84 (concat "#" (prin1-to-string arg t)))
85 ((or (symbolp arg) (listp arg))
86 (concat "'" (prin1-to-string arg)))
87 (t (prin1-to-string arg))))
88 args
89 " ")))
90
91(defun guix-guile-prompt? (string)
92 "Return non-nil, if STRING contains a Guile prompt."
93 (or (string-match-p geiser-guile--prompt-regexp string)
94 (string-match-p geiser-guile--debugger-prompt-regexp string)))
95
96(provide 'guix-guile)
97
98;;; guix-guile.el ends here
diff --git a/emacs/guix-help-vars.el b/emacs/guix-help-vars.el
deleted file mode 100644
index 8117d28f3e3..00000000000
--- a/emacs/guix-help-vars.el
+++ /dev/null
@@ -1,108 +0,0 @@
1;;; guix-help-vars.el --- Variables related to --help output
2
3;; Copyright © 2015 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 regular expressions to parse various "guix
23;; ... --help" outputs and lists of non-receivable items (system types,
24;; hash formats, etc.).
25
26;;; Code:
27
28
29;;; Regexps for parsing "guix ..." outputs
30
31(defvar guix-help-parse-option-regexp
32 (rx bol " "
33 (zero-or-one (group "-" (not (any "- ")))
34 ",")
35 (one-or-more " ")
36 (group "--" (one-or-more (or wordchar "-")))
37 (group (zero-or-one "[")
38 (zero-or-one "="))
39 (zero-or-more (not space))
40 (one-or-more space)
41 (group (one-or-more any)))
42 "Common regexp used to find command options.")
43
44(defvar guix-help-parse-command-regexp
45 (rx bol " "
46 (group wordchar (one-or-more (or wordchar "-"))))
47 "Regexp used to find guix commands.
48'Command' means any option not prefixed with '-'. For example,
49guix subcommand, system action, importer, etc.")
50
51(defvar guix-help-parse-long-option-regexp
52 (rx (or " " ", ")
53 (group "--" (one-or-more (or wordchar "-"))
54 (zero-or-one "=")))
55 "Regexp used to find long options.")
56
57(defvar guix-help-parse-short-option-regexp
58 (rx bol (one-or-more blank)
59 "-" (group (not (any "- "))))
60 "Regexp used to find short options.")
61
62(defvar guix-help-parse-package-regexp
63 (rx bol (group (one-or-more (not blank))))
64 "Regexp used to find names of the packages.")
65
66(defvar guix-help-parse-list-regexp
67 (rx bol (zero-or-more blank) "- "
68 (group (one-or-more (or wordchar "-"))))
69 "Regexp used to find various lists (lint checkers, graph types).")
70
71(defvar guix-help-parse-regexp-group 1
72 "Parenthesized expression of regexps used to find commands and
73options.")
74
75
76;;; Non-receivable lists of system types, hash formats, etc.
77
78(defvar guix-help-system-types
79 '("x86_64-linux" "i686-linux" "armhf-linux" "mips64el-linux")
80 "List of supported systems.")
81
82(defvar guix-help-source-types
83 '("package" "all" "transitive")
84 "List of supported sources types.")
85
86(defvar guix-help-hash-formats
87 '("nix-base32" "base32" "base16" "hex" "hexadecimal")
88 "List of supported hash formats.")
89
90(defvar guix-help-refresh-subsets
91 '("core" "non-core")
92 "List of supported 'refresh' subsets.")
93
94(defvar guix-help-key-policies
95 '("interactive" "always" "never")
96 "List of supported key download policies.")
97
98(defvar guix-help-verify-options
99 '("repair" "contents")
100 "List of supported 'verify' options")
101
102(defvar guix-help-elpa-archives
103 '("gnu" "melpa" "melpa-stable")
104 "List of supported ELPA archives.")
105
106(provide 'guix-help-vars)
107
108;;; guix-help-vars.el ends here
diff --git a/emacs/guix-helper.scm.in b/emacs/guix-helper.scm.in
deleted file mode 100644
index 0bbd36be21d..00000000000
--- a/emacs/guix-helper.scm.in
+++ /dev/null
@@ -1,65 +0,0 @@
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-path)
54 (push! module-dir %load-compiled-path)
55 (if (and updates-dir (file-exists? updates-dir))
56 (begin
57 (set! %guix-dir updates-dir)
58 (push! updates-dir %load-path)
59 (push! updates-dir %load-compiled-path))
60 (set! %guix-dir module-dir))))
61
62(set-paths!)
63
64(load-from-path "guix-main")
65
diff --git a/emacs/guix-history.el b/emacs/guix-history.el
deleted file mode 100644
index 5d301a689e8..00000000000
--- a/emacs/guix-history.el
+++ /dev/null
@@ -1,92 +0,0 @@
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-hydra-build.el b/emacs/guix-hydra-build.el
deleted file mode 100644
index 232221e7738..00000000000
--- a/emacs/guix-hydra-build.el
+++ /dev/null
@@ -1,362 +0,0 @@
1;;; guix-hydra-build.el --- Interface for Hydra builds -*- lexical-binding: t -*-
2
3;; Copyright © 2015 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 an interface for displaying Hydra builds in
23;; 'list' and 'info' buffers.
24
25;;; Code:
26
27(require 'cl-lib)
28(require 'guix-buffer)
29(require 'guix-list)
30(require 'guix-info)
31(require 'guix-hydra)
32(require 'guix-build-log)
33(require 'guix-utils)
34
35(guix-hydra-define-entry-type hydra-build
36 :search-types '((latest . guix-hydra-build-latest-api-url)
37 (queue . guix-hydra-build-queue-api-url))
38 :filters '(guix-hydra-build-filter-status)
39 :filter-names '((nixname . name)
40 (buildstatus . build-status)
41 (timestamp . time))
42 :filter-boolean-params '(finished busy))
43
44(defun guix-hydra-build-get-display (search-type &rest args)
45 "Search for Hydra builds and show results."
46 (apply #'guix-list-get-display-entries
47 'hydra-build search-type args))
48
49(cl-defun guix-hydra-build-latest-prompt-args (&key project jobset
50 job system)
51 "Prompt for and return a list of 'latest builds' arguments."
52 (let* ((number (read-number "Number of latest builds: "))
53 (project (if current-prefix-arg
54 (guix-hydra-read-project nil project)
55 project))
56 (jobset (if current-prefix-arg
57 (guix-hydra-read-jobset nil jobset)
58 jobset))
59 (job-or-name (if current-prefix-arg
60 (guix-hydra-read-job nil job)
61 job))
62 (job (and job-or-name
63 (string-match-p guix-hydra-job-regexp
64 job-or-name)
65 job-or-name))
66 (system (if (and (not job)
67 (or current-prefix-arg
68 (and job-or-name (not system))))
69 (if job-or-name
70 (guix-while-null
71 (guix-hydra-read-system
72 (concat job-or-name ".") system))
73 (guix-hydra-read-system nil system))
74 system))
75 (job (or job
76 (and job-or-name
77 (concat job-or-name "." system)))))
78 (list number
79 :project project
80 :jobset jobset
81 :job job
82 :system system)))
83
84(defun guix-hydra-build-view-log (id)
85 "View build log of a hydra build ID."
86 (guix-build-log-find-file (guix-hydra-build-log-url id)))
87
88
89;;; Defining URLs
90
91(defun guix-hydra-build-url (id)
92 "Return Hydra URL of a build ID."
93 (guix-hydra-url "build/" (number-to-string id)))
94
95(defun guix-hydra-build-log-url (id)
96 "Return Hydra URL of the log file of a build ID."
97 (concat (guix-hydra-build-url id) "/log/raw"))
98
99(cl-defun guix-hydra-build-latest-api-url
100 (number &key project jobset job system)
101 "Return Hydra API URL to receive latest NUMBER of builds."
102 (guix-hydra-api-url "latestbuilds"
103 `(("nr" . ,number)
104 ("project" . ,project)
105 ("jobset" . ,jobset)
106 ("job" . ,job)
107 ("system" . ,system))))
108
109(defun guix-hydra-build-queue-api-url (number)
110 "Return Hydra API URL to receive the NUMBER of queued builds."
111 (guix-hydra-api-url "queue"
112 `(("nr" . ,number))))
113
114
115;;; Filters for processing raw entries
116
117(defun guix-hydra-build-filter-status (entry)
118 "Add 'status' parameter to 'hydra-build' ENTRY."
119 (let ((status (if (guix-entry-value entry 'finished)
120 (guix-hydra-build-status-number->name
121 (guix-entry-value entry 'build-status))
122 (if (guix-entry-value entry 'busy)
123 'running
124 'scheduled))))
125 (cons `(status . ,status)
126 entry)))
127
128
129;;; Build status
130
131(defface guix-hydra-build-status-running
132 '((t :inherit bold))
133 "Face used if hydra build is not finished."
134 :group 'guix-hydra-build-faces)
135
136(defface guix-hydra-build-status-scheduled
137 '((t))
138 "Face used if hydra build is scheduled."
139 :group 'guix-hydra-build-faces)
140
141(defface guix-hydra-build-status-succeeded
142 '((t :inherit success))
143 "Face used if hydra build succeeded."
144 :group 'guix-hydra-build-faces)
145
146(defface guix-hydra-build-status-cancelled
147 '((t :inherit warning))
148 "Face used if hydra build was cancelled."
149 :group 'guix-hydra-build-faces)
150
151(defface guix-hydra-build-status-failed
152 '((t :inherit error))
153 "Face used if hydra build failed."
154 :group 'guix-hydra-build-faces)
155
156(defvar guix-hydra-build-status-alist
157 '((0 . succeeded)
158 (1 . failed-build)
159 (2 . failed-dependency)
160 (3 . failed-other)
161 (4 . cancelled))
162 "Alist of hydra build status numbers and status names.
163Status numbers are returned by Hydra API, names (symbols) are
164used internally by the elisp code of this package.")
165
166(defun guix-hydra-build-status-number->name (number)
167 "Convert build status number to a name.
168See `guix-hydra-build-status-alist'."
169 (guix-assq-value guix-hydra-build-status-alist number))
170
171(defun guix-hydra-build-status-string (status)
172 "Return a human readable string for build STATUS."
173 (cl-case status
174 (scheduled
175 (guix-get-string "Scheduled" 'guix-hydra-build-status-scheduled))
176 (running
177 (guix-get-string "Running" 'guix-hydra-build-status-running))
178 (succeeded
179 (guix-get-string "Succeeded" 'guix-hydra-build-status-succeeded))
180 (cancelled
181 (guix-get-string "Cancelled" 'guix-hydra-build-status-cancelled))
182 (failed-build
183 (guix-hydra-build-status-fail-string))
184 (failed-dependency
185 (guix-hydra-build-status-fail-string "dependency"))
186 (failed-other
187 (guix-hydra-build-status-fail-string "other"))))
188
189(defun guix-hydra-build-status-fail-string (&optional reason)
190 "Return a string for a failed build."
191 (let ((base (guix-get-string "Failed" 'guix-hydra-build-status-failed)))
192 (if reason
193 (concat base " (" reason ")")
194 base)))
195
196(defun guix-hydra-build-finished? (entry)
197 "Return non-nil, if hydra build was finished."
198 (guix-entry-value entry 'finished))
199
200(defun guix-hydra-build-running? (entry)
201 "Return non-nil, if hydra build is running."
202 (eq (guix-entry-value entry 'status)
203 'running))
204
205(defun guix-hydra-build-scheduled? (entry)
206 "Return non-nil, if hydra build is scheduled."
207 (eq (guix-entry-value entry 'status)
208 'scheduled))
209
210(defun guix-hydra-build-succeeded? (entry)
211 "Return non-nil, if hydra build succeeded."
212 (eq (guix-entry-value entry 'status)
213 'succeeded))
214
215(defun guix-hydra-build-cancelled? (entry)
216 "Return non-nil, if hydra build was cancelled."
217 (eq (guix-entry-value entry 'status)
218 'cancelled))
219
220(defun guix-hydra-build-failed? (entry)
221 "Return non-nil, if hydra build failed."
222 (memq (guix-entry-value entry 'status)
223 '(failed-build failed-dependency failed-other)))
224
225
226;;; Hydra build 'info'
227
228(guix-hydra-info-define-interface hydra-build
229 :mode-name "Hydra-Build-Info"
230 :buffer-name "*Guix Hydra Build Info*"
231 :format '((name ignore (simple guix-info-heading))
232 ignore
233 guix-hydra-build-info-insert-url
234 (time format (time))
235 (status format guix-hydra-build-info-insert-status)
236 (project format (format guix-hydra-build-project))
237 (jobset format (format guix-hydra-build-jobset))
238 (job format (format guix-hydra-build-job))
239 (system format (format guix-hydra-build-system))
240 (priority format (format))))
241
242(defface guix-hydra-build-info-project
243 '((t :inherit link))
244 "Face for project names."
245 :group 'guix-hydra-build-info-faces)
246
247(defface guix-hydra-build-info-jobset
248 '((t :inherit link))
249 "Face for jobsets."
250 :group 'guix-hydra-build-info-faces)
251
252(defface guix-hydra-build-info-job
253 '((t :inherit link))
254 "Face for jobs."
255 :group 'guix-hydra-build-info-faces)
256
257(defface guix-hydra-build-info-system
258 '((t :inherit link))
259 "Face for system names."
260 :group 'guix-hydra-build-info-faces)
261
262(defmacro guix-hydra-build-define-button (name)
263 "Define `guix-hydra-build-NAME' button."
264 (let* ((name-str (symbol-name name))
265 (button-name (intern (concat "guix-hydra-build-" name-str)))
266 (face-name (intern (concat "guix-hydra-build-info-" name-str)))
267 (keyword (intern (concat ":" name-str))))
268 `(define-button-type ',button-name
269 :supertype 'guix
270 'face ',face-name
271 'help-echo ,(format "\
272Show latest builds for this %s (with prefix, prompt for all parameters)"
273 name-str)
274 'action (lambda (btn)
275 (let ((args (guix-hydra-build-latest-prompt-args
276 ,keyword (button-label btn))))
277 (apply #'guix-hydra-build-get-display
278 'latest args))))))
279
280(guix-hydra-build-define-button project)
281(guix-hydra-build-define-button jobset)
282(guix-hydra-build-define-button job)
283(guix-hydra-build-define-button system)
284
285(defun guix-hydra-build-info-insert-url (entry)
286 "Insert Hydra URL for the build ENTRY."
287 (guix-insert-button (guix-hydra-build-url (guix-entry-id entry))
288 'guix-url)
289 (when (guix-hydra-build-finished? entry)
290 (guix-info-insert-indent)
291 (guix-info-insert-action-button
292 "Build log"
293 (lambda (btn)
294 (guix-hydra-build-view-log (button-get btn 'id)))
295 "View build log"
296 'id (guix-entry-id entry))))
297
298(defun guix-hydra-build-info-insert-status (status &optional _)
299 "Insert a string with build STATUS."
300 (insert (guix-hydra-build-status-string status)))
301
302
303;;; Hydra build 'list'
304
305(guix-hydra-list-define-interface hydra-build
306 :mode-name "Hydra-Build-List"
307 :buffer-name "*Guix Hydra Build List*"
308 :format '((name nil 30 t)
309 (system nil 16 t)
310 (status guix-hydra-build-list-get-status 20 t)
311 (project nil 10 t)
312 (jobset nil 17 t)
313 (time guix-list-get-time 20 t)))
314
315(let ((map guix-hydra-build-list-mode-map))
316 (define-key map (kbd "B") 'guix-hydra-build-list-latest-builds)
317 (define-key map (kbd "L") 'guix-hydra-build-list-view-log))
318
319(defun guix-hydra-build-list-get-status (status &optional _)
320 "Return a string for build STATUS."
321 (guix-hydra-build-status-string status))
322
323(defun guix-hydra-build-list-latest-builds (number &rest args)
324 "Display latest NUMBER of Hydra builds of the current job.
325Interactively, prompt for NUMBER. With prefix argument, prompt
326for all ARGS."
327 (interactive
328 (let ((entry (guix-list-current-entry)))
329 (guix-hydra-build-latest-prompt-args
330 :project (guix-entry-value entry 'project)
331 :jobset (guix-entry-value entry 'name)
332 :job (guix-entry-value entry 'job)
333 :system (guix-entry-value entry 'system))))
334 (apply #'guix-hydra-latest-builds number args))
335
336(defun guix-hydra-build-list-view-log ()
337 "View build log of the current Hydra build."
338 (interactive)
339 (guix-hydra-build-view-log (guix-list-current-id)))
340
341
342;;; Interactive commands
343
344;;;###autoload
345(defun guix-hydra-latest-builds (number &rest args)
346 "Display latest NUMBER of Hydra builds.
347ARGS are the same arguments as for `guix-hydra-build-latest-api-url'.
348Interactively, prompt for NUMBER. With prefix argument, prompt
349for all ARGS."
350 (interactive (guix-hydra-build-latest-prompt-args))
351 (apply #'guix-hydra-build-get-display
352 'latest number args))
353
354;;;###autoload
355(defun guix-hydra-queued-builds (number)
356 "Display the NUMBER of queued Hydra builds."
357 (interactive "NNumber of queued builds: ")
358 (guix-hydra-build-get-display 'queue number))
359
360(provide 'guix-hydra-build)
361
362;;; guix-hydra-build.el ends here
diff --git a/emacs/guix-hydra-jobset.el b/emacs/guix-hydra-jobset.el
deleted file mode 100644
index a4a55a36f2a..00000000000
--- a/emacs/guix-hydra-jobset.el
+++ /dev/null
@@ -1,162 +0,0 @@
1;;; guix-hydra-jobset.el --- Interface for Hydra jobsets -*- lexical-binding: t -*-
2
3;; Copyright © 2015 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 an interface for displaying Hydra jobsets in
23;; 'list' and 'info' buffers.
24
25;;; Code:
26
27(require 'cl-lib)
28(require 'guix-buffer)
29(require 'guix-list)
30(require 'guix-info)
31(require 'guix-hydra)
32(require 'guix-hydra-build)
33(require 'guix-utils)
34
35(guix-hydra-define-entry-type hydra-jobset
36 :search-types '((project . guix-hydra-jobset-api-url))
37 :filters '(guix-hydra-jobset-filter-id)
38 :filter-names '((nrscheduled . scheduled)
39 (nrsucceeded . succeeded)
40 (nrfailed . failed)
41 (nrtotal . total)))
42
43(defun guix-hydra-jobset-get-display (search-type &rest args)
44 "Search for Hydra builds and show results."
45 (apply #'guix-list-get-display-entries
46 'hydra-jobset search-type args))
47
48
49;;; Defining URLs
50
51(defun guix-hydra-jobset-url (project jobset)
52 "Return Hydra URL of a PROJECT's JOBSET."
53 (guix-hydra-url "jobset/" project "/" jobset))
54
55(defun guix-hydra-jobset-api-url (project)
56 "Return Hydra API URL for jobsets by PROJECT."
57 (guix-hydra-api-url "jobsets"
58 `(("project" . ,project))))
59
60
61;;; Filters for processing raw entries
62
63(defun guix-hydra-jobset-filter-id (entry)
64 "Add 'ID' parameter to 'hydra-jobset' ENTRY."
65 (cons `(id . ,(guix-entry-value entry 'name))
66 entry))
67
68
69;;; Hydra jobset 'info'
70
71(guix-hydra-info-define-interface hydra-jobset
72 :mode-name "Hydra-Jobset-Info"
73 :buffer-name "*Guix Hydra Jobset Info*"
74 :format '((name ignore (simple guix-info-heading))
75 ignore
76 guix-hydra-jobset-info-insert-url
77 (project format guix-hydra-jobset-info-insert-project)
78 (scheduled format (format guix-hydra-jobset-info-scheduled))
79 (succeeded format (format guix-hydra-jobset-info-succeeded))
80 (failed format (format guix-hydra-jobset-info-failed))
81 (total format (format guix-hydra-jobset-info-total))))
82
83(defface guix-hydra-jobset-info-scheduled
84 '((t))
85 "Face used for the number of scheduled builds."
86 :group 'guix-hydra-jobset-info-faces)
87
88(defface guix-hydra-jobset-info-succeeded
89 '((t :inherit guix-hydra-build-status-succeeded))
90 "Face used for the number of succeeded builds."
91 :group 'guix-hydra-jobset-info-faces)
92
93(defface guix-hydra-jobset-info-failed
94 '((t :inherit guix-hydra-build-status-failed))
95 "Face used for the number of failed builds."
96 :group 'guix-hydra-jobset-info-faces)
97
98(defface guix-hydra-jobset-info-total
99 '((t))
100 "Face used for the total number of builds."
101 :group 'guix-hydra-jobset-info-faces)
102
103(defun guix-hydra-jobset-info-insert-project (project entry)
104 "Insert PROJECT button for the jobset ENTRY."
105 (let ((jobset (guix-entry-value entry 'name)))
106 (guix-insert-button
107 project 'guix-hydra-build-project
108 'action (lambda (btn)
109 (let ((args (guix-hydra-build-latest-prompt-args
110 :project (button-get btn 'project)
111 :jobset (button-get btn 'jobset))))
112 (apply #'guix-hydra-build-get-display
113 'latest args)))
114 'project project
115 'jobset jobset)))
116
117(defun guix-hydra-jobset-info-insert-url (entry)
118 "Insert Hydra URL for the jobset ENTRY."
119 (guix-insert-button (guix-hydra-jobset-url
120 (guix-entry-value entry 'project)
121 (guix-entry-value entry 'name))
122 'guix-url))
123
124
125;;; Hydra jobset 'list'
126
127(guix-hydra-list-define-interface hydra-jobset
128 :mode-name "Hydra-Jobset-List"
129 :buffer-name "*Guix Hydra Jobset List*"
130 :format '((name nil 25 t)
131 (project nil 10 t)
132 (scheduled nil 12 t)
133 (succeeded nil 12 t)
134 (failed nil 9 t)
135 (total nil 10 t)))
136
137(let ((map guix-hydra-jobset-list-mode-map))
138 (define-key map (kbd "B") 'guix-hydra-jobset-list-latest-builds))
139
140(defun guix-hydra-jobset-list-latest-builds (number &rest args)
141 "Display latest NUMBER of Hydra builds of the current jobset.
142Interactively, prompt for NUMBER. With prefix argument, prompt
143for all ARGS."
144 (interactive
145 (let ((entry (guix-list-current-entry)))
146 (guix-hydra-build-latest-prompt-args
147 :project (guix-entry-value entry 'project)
148 :jobset (guix-entry-value entry 'name))))
149 (apply #'guix-hydra-latest-builds number args))
150
151
152;;; Interactive commands
153
154;;;###autoload
155(defun guix-hydra-jobsets (project)
156 "Display jobsets of PROJECT."
157 (interactive (list (guix-hydra-read-project)))
158 (guix-hydra-jobset-get-display 'project project))
159
160(provide 'guix-hydra-jobset)
161
162;;; guix-hydra-jobset.el ends here
diff --git a/emacs/guix-hydra.el b/emacs/guix-hydra.el
deleted file mode 100644
index 9f876e7eead..00000000000
--- a/emacs/guix-hydra.el
+++ /dev/null
@@ -1,367 +0,0 @@
1;;; guix-hydra.el --- Common code for interacting with Hydra -*- lexical-binding: t -*-
2
3;; Copyright © 2015 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 general code for 'list'/'info' interfaces for
23;; Hydra (Guix build farm).
24
25;;; Code:
26
27(require 'json)
28(require 'guix-buffer)
29(require 'guix-entry)
30(require 'guix-utils)
31(require 'guix-help-vars)
32
33(guix-define-groups hydra)
34
35(defvar guix-hydra-job-regexp
36 (concat ".*\\." (regexp-opt guix-help-system-types) "\\'")
37 "Regexp matching a full name of Hydra job (including system).")
38
39(defun guix-hydra-job-name-specification (name version)
40 "Return Hydra's job name specification by NAME and VERSION."
41 (concat name "-" version))
42
43(defun guix-hydra-message (entries search-type &rest _)
44 "Display a message after showing Hydra ENTRIES."
45 ;; XXX Add more messages maybe.
46 (when (null entries)
47 (if (eq search-type 'fake)
48 (message "The update is impossible due to lack of Hydra API.")
49 (message "Hydra has returned no results."))))
50
51(defun guix-hydra-list-describe (ids)
52 "Describe 'hydra' entries with IDS (list of identifiers)."
53 (guix-buffer-display-entries
54 (guix-entries-by-ids ids (guix-buffer-current-entries))
55 'info (guix-buffer-current-entry-type)
56 ;; Hydra does not provide an API to receive builds/jobsets by
57 ;; IDs/names, so we use a 'fake' search type.
58 '(fake)
59 'add))
60
61
62;;; Readers
63
64(defvar guix-hydra-projects
65 '("gnu" "guix")
66 "List of available Hydra projects.")
67
68(guix-define-readers
69 :completions-var guix-hydra-projects
70 :single-reader guix-hydra-read-project
71 :single-prompt "Project: ")
72
73(guix-define-readers
74 :single-reader guix-hydra-read-jobset
75 :single-prompt "Jobset: ")
76
77(guix-define-readers
78 :single-reader guix-hydra-read-job
79 :single-prompt "Job: ")
80
81(guix-define-readers
82 :completions-var guix-help-system-types
83 :single-reader guix-hydra-read-system
84 :single-prompt "System: ")
85
86
87;;; Defining URLs
88
89(defvar guix-hydra-url "http://hydra.gnu.org"
90 "URL of the Hydra build farm.")
91
92(defun guix-hydra-url (&rest url-parts)
93 "Return Hydra URL."
94 (apply #'concat guix-hydra-url "/" url-parts))
95
96(defun guix-hydra-api-url (type args)
97 "Return URL for receiving data using Hydra API.
98TYPE is the name of an allowed method.
99ARGS is alist of (KEY . VALUE) pairs.
100Skip ARG, if VALUE is nil or an empty string."
101 (declare (indent 1))
102 (let* ((fields (mapcar
103 (lambda (arg)
104 (pcase arg
105 (`(,key . ,value)
106 (unless (or (null value)
107 (equal "" value))
108 (concat (guix-hexify key) "="
109 (guix-hexify value))))
110 (_ (error "Wrong argument '%s'" arg))))
111 args))
112 (fields (mapconcat #'identity (delq nil fields) "&")))
113 (guix-hydra-url "api/" type "?" fields)))
114
115
116;;; Receiving data from Hydra
117
118(defun guix-hydra-receive-data (url)
119 "Return output received from URL and processed with `json-read'."
120 (with-temp-buffer
121 (url-insert-file-contents url)
122 (goto-char (point-min))
123 (let ((json-key-type 'symbol)
124 (json-array-type 'list)
125 (json-object-type 'alist))
126 (json-read))))
127
128(defun guix-hydra-get-entries (entry-type search-type &rest args)
129 "Receive ENTRY-TYPE entries from Hydra.
130SEARCH-TYPE is one of the types defined by `guix-hydra-define-interface'."
131 (unless (eq search-type 'fake)
132 (let* ((url (apply #'guix-hydra-search-url
133 entry-type search-type args))
134 (raw-entries (guix-hydra-receive-data url))
135 (entries (guix-hydra-filter-entries
136 raw-entries
137 (guix-hydra-filters entry-type))))
138 entries)))
139
140
141;;; Filters for processing raw entries
142
143(defun guix-hydra-filter-entries (entries filters)
144 "Filter ENTRIES using FILTERS.
145Call `guix-modify' on each entry from ENTRIES."
146 (mapcar (lambda (entry)
147 (guix-modify entry filters))
148 entries))
149
150(defun guix-hydra-filter-names (entry name-alist)
151 "Replace names of ENTRY parameters using NAME-ALIST.
152Each element of NAME-ALIST is (OLD-NAME . NEW-NAME) pair."
153 (mapcar (lambda (param)
154 (pcase param
155 (`(,name . ,val)
156 (let ((new-name (guix-assq-value name-alist name)))
157 (if new-name
158 (cons new-name val)
159 param)))))
160 entry))
161
162(defun guix-hydra-filter-boolean (entry params)
163 "Convert number PARAMS (0/1) of ENTRY to boolean values (nil/t)."
164 (mapcar (lambda (param)
165 (pcase param
166 (`(,name . ,val)
167 (if (memq name params)
168 (cons name (guix-number->bool val))
169 param))))
170 entry))
171
172
173;;; Wrappers for defined variables
174
175(defvar guix-hydra-entry-type-data nil
176 "Alist with hydra entry type data.
177This alist is filled by `guix-hydra-define-entry-type' macro.")
178
179(defun guix-hydra-entry-type-value (entry-type symbol)
180 "Return SYMBOL's value for ENTRY-TYPE from `guix-hydra'."
181 (symbol-value (guix-assq-value guix-hydra-entry-type-data
182 entry-type symbol)))
183
184(defun guix-hydra-search-url (entry-type search-type &rest args)
185 "Return URL to receive ENTRY-TYPE entries from Hydra."
186 (apply (guix-assq-value (guix-hydra-entry-type-value
187 entry-type 'search-types)
188 search-type)
189 args))
190
191(defun guix-hydra-filters (entry-type)
192 "Return a list of filters for ENTRY-TYPE."
193 (guix-hydra-entry-type-value entry-type 'filters))
194
195
196;;; Interface definers
197
198(defmacro guix-hydra-define-entry-type (entry-type &rest args)
199 "Define general code for ENTRY-TYPE.
200Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
201
202Required keywords:
203
204 - `:search-types' - default value of the generated
205 `guix-ENTRY-TYPE-search-types' variable.
206
207Optional keywords:
208
209 - `:filters' - default value of the generated
210 `guix-ENTRY-TYPE-filters' variable.
211
212 - `:filter-names' - if specified, a generated
213 `guix-ENTRY-TYPE-filter-names' function for filtering these
214 names will be added to `guix-ENTRY-TYPE-filters' variable.
215
216 - `:filter-boolean-params' - if specified, a generated
217 `guix-ENTRY-TYPE-filter-boolean' function for filtering these
218 names will be added to `guix-ENTRY-TYPE-filters' variable.
219
220The rest keyword arguments are passed to
221`guix-define-entry-type' macro."
222 (declare (indent 1))
223 (let* ((entry-type-str (symbol-name entry-type))
224 (prefix (concat "guix-" entry-type-str))
225 (search-types-var (intern (concat prefix "-search-types")))
226 (filters-var (intern (concat prefix "-filters")))
227 (get-fun (intern (concat prefix "-get-entries"))))
228 (guix-keyword-args-let args
229 ((search-types-val :search-types)
230 (filters-val :filters)
231 (filter-names-val :filter-names)
232 (filter-bool-val :filter-boolean-params))
233 `(progn
234 (defvar ,search-types-var ,search-types-val
235 ,(format "\
236Alist of search types and according URL functions.
237Functions are used to define URL to receive '%s' entries."
238 entry-type-str))
239
240 (defvar ,filters-var ,filters-val
241 ,(format "\
242List of filters for '%s' parameters.
243Each filter is a function that should take an entry as a single
244argument, and should also return an entry."
245 entry-type-str))
246
247 ,(when filter-bool-val
248 (let ((filter-bool-var (intern (concat prefix
249 "-filter-boolean-params")))
250 (filter-bool-fun (intern (concat prefix
251 "-filter-boolean"))))
252 `(progn
253 (defvar ,filter-bool-var ,filter-bool-val
254 ,(format "\
255List of '%s' parameters that should be transformed to boolean values."
256 entry-type-str))
257
258 (defun ,filter-bool-fun (entry)
259 ,(format "\
260Run `guix-hydra-filter-boolean' with `%S' variable."
261 filter-bool-var)
262 (guix-hydra-filter-boolean entry ,filter-bool-var))
263
264 (setq ,filters-var
265 (cons ',filter-bool-fun ,filters-var)))))
266
267 ;; Do not move this clause up!: name filtering should be
268 ;; performed before any other filtering, so this filter should
269 ;; be consed after the boolean filter.
270 ,(when filter-names-val
271 (let* ((filter-names-var (intern (concat prefix
272 "-filter-names")))
273 (filter-names-fun filter-names-var))
274 `(progn
275 (defvar ,filter-names-var ,filter-names-val
276 ,(format "\
277Alist of '%s' parameter names returned by Hydra API and names
278used internally by the elisp code of this package."
279 entry-type-str))
280
281 (defun ,filter-names-fun (entry)
282 ,(format "\
283Run `guix-hydra-filter-names' with `%S' variable."
284 filter-names-var)
285 (guix-hydra-filter-names entry ,filter-names-var))
286
287 (setq ,filters-var
288 (cons ',filter-names-fun ,filters-var)))))
289
290 (defun ,get-fun (search-type &rest args)
291 ,(format "\
292Receive '%s' entries.
293See `guix-hydra-get-entries' for details."
294 entry-type-str)
295 (apply #'guix-hydra-get-entries
296 ',entry-type search-type args))
297
298 (guix-alist-put!
299 '((search-types . ,search-types-var)
300 (filters . ,filters-var))
301 'guix-hydra-entry-type-data ',entry-type)
302
303 (guix-define-entry-type ,entry-type
304 :parent-group guix-hydra
305 :parent-faces-group guix-hydra-faces
306 ,@%foreign-args)))))
307
308(defmacro guix-hydra-define-interface (buffer-type entry-type &rest args)
309 "Define BUFFER-TYPE interface for displaying ENTRY-TYPE entries.
310
311This macro should be called after calling
312`guix-hydra-define-entry-type' with the same ENTRY-TYPE.
313
314ARGS are passed to `guix-BUFFER-TYPE-define-interface' macro."
315 (declare (indent 2))
316 (let* ((entry-type-str (symbol-name entry-type))
317 (buffer-type-str (symbol-name buffer-type))
318 (get-fun (intern (concat "guix-" entry-type-str
319 "-get-entries")))
320 (definer (intern (concat "guix-" buffer-type-str
321 "-define-interface"))))
322 `(,definer ,entry-type
323 :get-entries-function ',get-fun
324 :message-function 'guix-hydra-message
325 ,@args)))
326
327(defmacro guix-hydra-info-define-interface (entry-type &rest args)
328 "Define 'info' interface for displaying ENTRY-TYPE entries.
329See `guix-hydra-define-interface'."
330 (declare (indent 1))
331 `(guix-hydra-define-interface info ,entry-type
332 ,@args))
333
334(defmacro guix-hydra-list-define-interface (entry-type &rest args)
335 "Define 'list' interface for displaying ENTRY-TYPE entries.
336Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
337
338Optional keywords:
339
340 - `:describe-function' - default value of the generated
341 `guix-ENTRY-TYPE-list-describe-function' variable (if not
342 specified, use `guix-hydra-list-describe').
343
344The rest keyword arguments are passed to
345`guix-hydra-define-interface' macro."
346 (declare (indent 1))
347 (guix-keyword-args-let args
348 ((describe-val :describe-function))
349 `(guix-hydra-define-interface list ,entry-type
350 :describe-function ,(or describe-val ''guix-hydra-list-describe)
351 ,@args)))
352
353
354(defvar guix-hydra-font-lock-keywords
355 (eval-when-compile
356 `((,(rx "(" (group (or "guix-hydra-define-entry-type"
357 "guix-hydra-define-interface"
358 "guix-hydra-info-define-interface"
359 "guix-hydra-list-define-interface"))
360 symbol-end)
361 . 1))))
362
363(font-lock-add-keywords 'emacs-lisp-mode guix-hydra-font-lock-keywords)
364
365(provide 'guix-hydra)
366
367;;; guix-hydra.el ends here
diff --git a/emacs/guix-info.el b/emacs/guix-info.el
deleted file mode 100644
index 6aefd2f3f6e..00000000000
--- a/emacs/guix-info.el
+++ /dev/null
@@ -1,482 +0,0 @@
1;;; guix-info.el --- 'Info' buffer interface for displaying data -*- lexical-binding: t -*-
2
3;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
4;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
5
6;; This file is part of GNU Guix.
7
8;; GNU Guix is free software; you can redistribute it and/or modify
9;; it under the terms of the GNU General Public License as published by
10;; the Free Software Foundation, either version 3 of the License, or
11;; (at your option) any later version.
12
13;; GNU Guix is distributed in the hope that it will be useful,
14;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16;; GNU General Public License for more details.
17
18;; You should have received a copy of the GNU General Public License
19;; along with this program. If not, see <http://www.gnu.org/licenses/>.
20
21;;; Commentary:
22
23;; This file provides 'info' (help-like) buffer interface for displaying
24;; an arbitrary data.
25
26;;; Code:
27
28(require 'guix-buffer)
29(require 'guix-entry)
30(require 'guix-utils)
31
32(guix-define-buffer-type info)
33
34(defface guix-info-heading
35 '((((type tty pc) (class color)) :weight bold)
36 (t :height 1.6 :weight bold :inherit variable-pitch))
37 "Face for headings."
38 :group 'guix-info-faces)
39
40(defface guix-info-param-title
41 '((t :inherit font-lock-type-face))
42 "Face used for titles of parameters."
43 :group 'guix-info-faces)
44
45(defface guix-info-file-name
46 '((t :inherit link))
47 "Face used for file names."
48 :group 'guix-info-faces)
49
50(defface guix-info-url
51 '((t :inherit link))
52 "Face used for URLs."
53 :group 'guix-info-faces)
54
55(defface guix-info-time
56 '((t :inherit font-lock-constant-face))
57 "Face used for timestamps."
58 :group 'guix-info-faces)
59
60(defface guix-info-action-button
61 '((((type x w32 ns) (class color))
62 :box (:line-width 2 :style released-button)
63 :background "lightgrey" :foreground "black")
64 (t :inherit button))
65 "Face used for action buttons."
66 :group 'guix-info-faces)
67
68(defface guix-info-action-button-mouse
69 '((((type x w32 ns) (class color))
70 :box (:line-width 2 :style released-button)
71 :background "grey90" :foreground "black")
72 (t :inherit highlight))
73 "Mouse face used for action buttons."
74 :group 'guix-info-faces)
75
76(defcustom guix-info-ignore-empty-values nil
77 "If non-nil, do not display parameters with nil values."
78 :type 'boolean
79 :group 'guix-info)
80
81(defcustom guix-info-fill t
82 "If non-nil, fill string parameters to fit the window.
83If nil, insert text parameters (like synopsis or description) in
84a raw form."
85 :type 'boolean
86 :group 'guix-info)
87
88(defvar guix-info-param-title-format "%-18s: "
89 "String used to format a title of a parameter.
90It should be a '%s'-sequence. After inserting a title formatted
91with this string, a value of the parameter is inserted.
92This string is used by `guix-info-insert-title-format'.")
93
94(defvar guix-info-multiline-prefix
95 (make-string (length (format guix-info-param-title-format " "))
96 ?\s)
97 "String used to format multi-line parameter values.
98If a value occupies more than one line, this string is inserted
99in the beginning of each line after the first one.
100This string is used by `guix-info-insert-value-format'.")
101
102(defvar guix-info-indent 2
103 "Number of spaces used to indent various parts of inserted text.")
104
105(defvar guix-info-delimiter "\n\f\n"
106 "String used to separate entries.")
107
108
109;;; Wrappers for 'info' variables
110
111(defvar guix-info-data nil
112 "Alist with 'info' data.
113This alist is filled by `guix-info-define-interface' macro.")
114
115(defun guix-info-value (entry-type symbol)
116 "Return SYMBOL's value for ENTRY-TYPE from `guix-info-data'."
117 (symbol-value (guix-assq-value guix-info-data entry-type symbol)))
118
119(defun guix-info-param-title (entry-type param)
120 "Return a title of an ENTRY-TYPE parameter PARAM."
121 (guix-buffer-param-title 'info entry-type param))
122
123(defun guix-info-format (entry-type)
124 "Return 'info' format for ENTRY-TYPE."
125 (guix-info-value entry-type 'format))
126
127(defun guix-info-displayed-params (entry-type)
128 "Return a list of ENTRY-TYPE parameters that should be displayed."
129 (delq nil
130 (mapcar (lambda (spec)
131 (pcase spec
132 (`(,param . ,_) param)))
133 (guix-info-format entry-type))))
134
135
136;;; Inserting entries
137
138(defvar guix-info-title-aliases
139 '((format . guix-info-insert-title-format)
140 (simple . guix-info-insert-title-simple))
141 "Alist of aliases and functions to insert titles.")
142
143(defvar guix-info-value-aliases
144 '((format . guix-info-insert-value-format)
145 (indent . guix-info-insert-value-indent)
146 (simple . guix-info-insert-value-simple)
147 (time . guix-info-insert-time))
148 "Alist of aliases and functions to insert values.")
149
150(defun guix-info-title-function (fun-or-alias)
151 "Convert FUN-OR-ALIAS into a function to insert a title."
152 (or (guix-assq-value guix-info-title-aliases fun-or-alias)
153 fun-or-alias))
154
155(defun guix-info-value-function (fun-or-alias)
156 "Convert FUN-OR-ALIAS into a function to insert a value."
157 (or (guix-assq-value guix-info-value-aliases fun-or-alias)
158 fun-or-alias))
159
160(defun guix-info-title-method->function (method)
161 "Convert title METHOD into a function to insert a title."
162 (pcase method
163 ((pred null) #'ignore)
164 ((pred symbolp) (guix-info-title-function method))
165 (`(,fun-or-alias . ,rest-args)
166 (lambda (title)
167 (apply (guix-info-title-function fun-or-alias)
168 title rest-args)))
169 (_ (error "Unknown title method '%S'" method))))
170
171(defun guix-info-value-method->function (method)
172 "Convert value METHOD into a function to insert a value."
173 (pcase method
174 ((pred null) #'ignore)
175 ((pred functionp) method)
176 (`(,fun-or-alias . ,rest-args)
177 (lambda (value _)
178 (apply (guix-info-value-function fun-or-alias)
179 value rest-args)))
180 (_ (error "Unknown value method '%S'" method))))
181
182(defun guix-info-fill-column ()
183 "Return fill column for the current window."
184 (min (window-width) fill-column))
185
186(defun guix-info-get-indent (&optional level)
187 "Return `guix-info-indent' \"multiplied\" by LEVEL spaces.
188LEVEL is 1 by default."
189 (make-string (* guix-info-indent (or level 1)) ?\s))
190
191(defun guix-info-insert-indent (&optional level)
192 "Insert `guix-info-indent' spaces LEVEL times (1 by default)."
193 (insert (guix-info-get-indent level)))
194
195(defun guix-info-insert-entries (entries entry-type)
196 "Display ENTRY-TYPE ENTRIES in the current info buffer."
197 (guix-mapinsert (lambda (entry)
198 (guix-info-insert-entry entry entry-type))
199 entries
200 guix-info-delimiter))
201
202(defun guix-info-insert-entry (entry entry-type &optional indent-level)
203 "Insert ENTRY of ENTRY-TYPE into the current info buffer.
204If INDENT-LEVEL is non-nil, indent displayed data by this number
205of `guix-info-indent' spaces."
206 (guix-with-indent (* (or indent-level 0)
207 guix-info-indent)
208 (dolist (spec (guix-info-format entry-type))
209 (guix-info-insert-entry-unit spec entry entry-type))))
210
211(defun guix-info-insert-entry-unit (format-spec entry entry-type)
212 "Insert title and value of a PARAM at point.
213ENTRY is alist with parameters and their values.
214ENTRY-TYPE is a type of ENTRY."
215 (pcase format-spec
216 ((pred functionp)
217 (funcall format-spec entry)
218 (insert "\n"))
219 (`(,param ,title-method ,value-method)
220 (let ((value (guix-entry-value entry param)))
221 (unless (and guix-info-ignore-empty-values (null value))
222 (let ((title (guix-info-param-title entry-type param))
223 (insert-title (guix-info-title-method->function title-method))
224 (insert-value (guix-info-value-method->function value-method)))
225 (funcall insert-title title)
226 (funcall insert-value value entry)
227 (insert "\n")))))
228 (_ (error "Unknown format specification '%S'" format-spec))))
229
230(defun guix-info-insert-title-simple (title &optional face)
231 "Insert \"TITLE: \" string at point.
232If FACE is nil, use `guix-info-param-title'."
233 (guix-format-insert title
234 (or face 'guix-info-param-title)
235 "%s: "))
236
237(defun guix-info-insert-title-format (title &optional face)
238 "Insert TITLE using `guix-info-param-title-format' at point.
239If FACE is nil, use `guix-info-param-title'."
240 (guix-format-insert title
241 (or face 'guix-info-param-title)
242 guix-info-param-title-format))
243
244(defun guix-info-insert-value-simple (value &optional button-or-face indent)
245 "Format and insert parameter VALUE at point.
246
247VALUE may be split into several short lines to fit the current
248window, depending on `guix-info-fill', and each line is indented
249with INDENT number of spaces.
250
251If BUTTON-OR-FACE is a button type symbol, transform VALUE into
252this (these) button(s) and insert each one on a new line. If it
253is a face symbol, propertize inserted line(s) with this face."
254 (or indent (setq indent 0))
255 (guix-with-indent indent
256 (let* ((button? (guix-button-type? button-or-face))
257 (face (unless button? button-or-face))
258 (fill-col (unless (or button?
259 (and (stringp value)
260 (not guix-info-fill)))
261 (- (guix-info-fill-column) indent)))
262 (value (if (and value button?)
263 (guix-buttonize value button-or-face "\n")
264 value)))
265 (guix-split-insert value face fill-col "\n"))))
266
267(defun guix-info-insert-value-indent (value &optional button-or-face)
268 "Format and insert parameter VALUE at point.
269
270This function is intended to be called after inserting a title
271with `guix-info-insert-title-simple'.
272
273VALUE may be split into several short lines to fit the current
274window, depending on `guix-info-fill', and each line is indented
275with `guix-info-indent'.
276
277For the meaning of BUTTON-OR-FACE, see `guix-info-insert-value-simple'."
278 (when value (insert "\n"))
279 (guix-info-insert-value-simple value button-or-face guix-info-indent))
280
281(defun guix-info-insert-value-format (value &optional button-or-face
282 &rest button-properties)
283 "Format and insert parameter VALUE at point.
284
285This function is intended to be called after inserting a title
286with `guix-info-insert-title-format'.
287
288VALUE may be split into several short lines to fit the current
289window, depending on `guix-info-fill' and
290`guix-info-multiline-prefix'. If VALUE is a list, its elements
291will be separated with `guix-list-separator'.
292
293If BUTTON-OR-FACE is a button type symbol, transform VALUE into
294this (these) button(s). If it is a face symbol, propertize
295inserted line(s) with this face.
296
297BUTTON-PROPERTIES are passed to `guix-buttonize' (only if
298BUTTON-OR-FACE is a button type)."
299 (let* ((button? (guix-button-type? button-or-face))
300 (face (unless button? button-or-face))
301 (fill-col (when (or button?
302 guix-info-fill
303 (not (stringp value)))
304 (- (guix-info-fill-column)
305 (length guix-info-multiline-prefix))))
306 (value (if (and value button?)
307 (apply #'guix-buttonize
308 value button-or-face guix-list-separator
309 button-properties)
310 value)))
311 (guix-split-insert value face fill-col
312 (concat "\n" guix-info-multiline-prefix))))
313
314(defun guix-info-insert-time (seconds &optional face)
315 "Insert formatted time string using SECONDS at point."
316 (guix-format-insert (guix-get-time-string seconds)
317 (or face 'guix-info-time)))
318
319
320;;; Buttons
321
322(defvar guix-info-button-map
323 (let ((map (make-sparse-keymap)))
324 (set-keymap-parent map button-map)
325 (define-key map (kbd "c") 'guix-info-button-copy-label)
326 map)
327 "Keymap for buttons in info buffers.")
328
329(define-button-type 'guix
330 'keymap guix-info-button-map
331 'follow-link t)
332
333(define-button-type 'guix-action
334 :supertype 'guix
335 'face 'guix-info-action-button
336 'mouse-face 'guix-info-action-button-mouse)
337
338(define-button-type 'guix-file
339 :supertype 'guix
340 'face 'guix-info-file-name
341 'help-echo "Find file"
342 'action (lambda (btn)
343 (guix-find-file (button-label btn))))
344
345(define-button-type 'guix-url
346 :supertype 'guix
347 'face 'guix-info-url
348 'help-echo "Browse URL"
349 'action (lambda (btn)
350 (browse-url (button-label btn))))
351
352(defun guix-info-button-copy-label (&optional pos)
353 "Copy a label of the button at POS into kill ring.
354If POS is nil, use the current point position."
355 (interactive)
356 (let ((button (button-at (or pos (point)))))
357 (when button
358 (guix-copy-as-kill (button-label button)))))
359
360(defun guix-info-insert-action-button (label action &optional message
361 &rest properties)
362 "Make action button with LABEL and insert it at point.
363ACTION is a function called when the button is pressed. It
364should accept button as the argument.
365MESSAGE is a button message.
366See `insert-text-button' for the meaning of PROPERTIES."
367 (apply #'guix-insert-button
368 label 'guix-action
369 'action action
370 'help-echo message
371 properties))
372
373
374;;; Major mode and interface definer
375
376(defvar guix-info-mode-map
377 (let ((map (make-sparse-keymap)))
378 (set-keymap-parent
379 map (make-composed-keymap (list guix-buffer-map button-buffer-map)
380 special-mode-map))
381 map)
382 "Keymap for `guix-info-mode' buffers.")
383
384(define-derived-mode guix-info-mode special-mode "Guix-Info"
385 "Parent mode for displaying data in 'info' form."
386 (setq-local revert-buffer-function 'guix-buffer-revert))
387
388(defun guix-info-mode-initialize ()
389 "Set up the current 'info' buffer."
390 ;; Without this, syntactic fontification is performed, and it may
391 ;; break our highlighting. For example, description of "emacs-typo"
392 ;; package contains a single " (double-quote) character, so the
393 ;; default syntactic fontification highlights the rest text after it
394 ;; as a string. See (info "(elisp) Font Lock Basics") for details.
395 (setq font-lock-defaults '(nil t)))
396
397(defmacro guix-info-define-interface (entry-type &rest args)
398 "Define 'info' interface for displaying ENTRY-TYPE entries.
399Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
400
401Required keywords:
402
403 - `:format' - default value of the generated
404 `guix-ENTRY-TYPE-info-format' variable.
405
406The rest keyword arguments are passed to
407`guix-buffer-define-interface' macro."
408 (declare (indent 1))
409 (let* ((entry-type-str (symbol-name entry-type))
410 (prefix (concat "guix-" entry-type-str "-info"))
411 (group (intern prefix))
412 (format-var (intern (concat prefix "-format"))))
413 (guix-keyword-args-let args
414 ((show-entries-val :show-entries-function)
415 (format-val :format))
416 `(progn
417 (defcustom ,format-var ,format-val
418 ,(format "\
419List of methods for inserting '%s' entry.
420Each METHOD should be either a function or should have the
421following form:
422
423 (PARAM INSERT-TITLE INSERT-VALUE)
424
425If METHOD is a function, it is called with an entry as argument.
426
427PARAM is a name of '%s' entry parameter.
428
429INSERT-TITLE may be either a symbol or a list. If it is a
430symbol, it should be a function or an alias from
431`guix-info-title-aliases', in which case it is called with title
432as argument. If it is a list, it should have a
433form (FUN-OR-ALIAS [ARGS ...]), in which case FUN-OR-ALIAS is
434called with title and ARGS as arguments.
435
436INSERT-VALUE may be either a symbol or a list. If it is a
437symbol, it should be a function or an alias from
438`guix-info-value-aliases', in which case it is called with value
439and entry as arguments. If it is a list, it should have a
440form (FUN-OR-ALIAS [ARGS ...]), in which case FUN-OR-ALIAS is
441called with value and ARGS as arguments.
442
443Parameters are inserted in the same order as defined by this list.
444After calling each METHOD, a new line is inserted."
445 entry-type-str entry-type-str)
446 :type 'sexp
447 :group ',group)
448
449 (guix-alist-put!
450 '((format . ,format-var))
451 'guix-info-data ',entry-type)
452
453 ,(if show-entries-val
454 `(guix-buffer-define-interface info ,entry-type
455 :show-entries-function ,show-entries-val
456 ,@%foreign-args)
457
458 (let ((insert-fun (intern (concat prefix "-insert-entries"))))
459 `(progn
460 (defun ,insert-fun (entries)
461 ,(format "\
462Print '%s' ENTRIES in the current 'info' buffer."
463 entry-type-str)
464 (guix-info-insert-entries entries ',entry-type))
465
466 (guix-buffer-define-interface info ,entry-type
467 :insert-entries-function ',insert-fun
468 :mode-init-function 'guix-info-mode-initialize
469 ,@%foreign-args))))))))
470
471
472(defvar guix-info-font-lock-keywords
473 (eval-when-compile
474 `((,(rx "(" (group "guix-info-define-interface")
475 symbol-end)
476 . 1))))
477
478(font-lock-add-keywords 'emacs-lisp-mode guix-info-font-lock-keywords)
479
480(provide 'guix-info)
481
482;;; guix-info.el ends here
diff --git a/emacs/guix-init.el b/emacs/guix-init.el
deleted file mode 100644
index bd75e54e03e..00000000000
--- a/emacs/guix-init.el
+++ /dev/null
@@ -1,3 +0,0 @@
1(require 'guix-autoloads)
2(message "(require 'guix-init) is obsolete, use (require 'guix-autoloads) instead.")
3(provide 'guix-init)
diff --git a/emacs/guix-license.el b/emacs/guix-license.el
deleted file mode 100644
index 6003a21aac6..00000000000
--- a/emacs/guix-license.el
+++ /dev/null
@@ -1,65 +0,0 @@
1;;; guix-license.el --- Licenses
2
3;; Copyright © 2016 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 to work with licenses of Guix packages.
23
24;;; Code:
25
26(require 'guix-read)
27(require 'guix-backend)
28(require 'guix-guile)
29
30(defun guix-license-file (&optional directory)
31 "Return name of the file with license definitions.
32DIRECTORY is a directory with Guix source (`guix-directory' by default)."
33 (expand-file-name "guix/licenses.scm"
34 (or directory guix-directory)))
35
36(defun guix-lookup-license-url (license)
37 "Return URL of a LICENSE."
38 (or (guix-eval-read (guix-make-guile-expression
39 'lookup-license-uri license))
40 (error "Hm, I don't know URL of '%s' license" license)))
41
42;;;###autoload
43(defun guix-find-license-definition (license &optional directory)
44 "Open licenses file from DIRECTORY and move to the LICENSE definition.
45See `guix-license-file' for the meaning of DIRECTORY.
46Interactively, with prefix argument, prompt for DIRECTORY."
47 (interactive
48 (list (guix-read-license-name)
49 (guix-read-directory)))
50 (find-file (guix-license-file directory))
51 (goto-char (point-min))
52 (when (re-search-forward (concat "\"" (regexp-quote license) "\"")
53 nil t)
54 (beginning-of-defun)
55 (recenter 1)))
56
57;;;###autoload
58(defun guix-browse-license-url (license)
59 "Browse URL of a LICENSE."
60 (interactive (list (guix-read-license-name)))
61 (browse-url (guix-lookup-license-url license)))
62
63(provide 'guix-license)
64
65;;; guix-license.el ends here
diff --git a/emacs/guix-list.el b/emacs/guix-list.el
deleted file mode 100644
index c91c67cb29b..00000000000
--- a/emacs/guix-list.el
+++ /dev/null
@@ -1,585 +0,0 @@
1;;; guix-list.el --- 'List' buffer interface for displaying data -*- lexical-binding: t -*-
2
3;; Copyright © 2014, 2015 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 'list' buffer interface for displaying an arbitrary
23;; data.
24
25;;; Code:
26
27(require 'cl-lib)
28(require 'tabulated-list)
29(require 'guix-buffer)
30(require 'guix-info)
31(require 'guix-entry)
32(require 'guix-utils)
33
34(guix-define-buffer-type list)
35
36(defface guix-list-file-name
37 '((t :inherit guix-info-file-name))
38 "Face used for file names."
39 :group 'guix-list-faces)
40
41(defface guix-list-url
42 '((t :inherit guix-info-url))
43 "Face used for URLs."
44 :group 'guix-list-faces)
45
46(defface guix-list-time
47 '((t :inherit guix-info-time))
48 "Face used for time stamps."
49 :group 'guix-list-faces)
50
51(defun guix-list-describe (&optional mark-names)
52 "Describe entries marked with a general mark.
53'Describe' means display entries in 'info' buffer.
54If no entries are marked, describe the current entry.
55With prefix argument, describe entries marked with any mark."
56 (interactive (list (unless current-prefix-arg '(general))))
57 (let* ((ids (or (apply #'guix-list-get-marked-id-list mark-names)
58 (list (guix-list-current-id))))
59 (count (length ids))
60 (entry-type (guix-buffer-current-entry-type)))
61 (when (or (<= count (guix-list-describe-warning-count entry-type))
62 (y-or-n-p (format "Do you really want to describe %d entries? "
63 count)))
64 (guix-list-describe-entries entry-type ids))))
65
66
67;;; Wrappers for 'list' variables
68
69(defvar guix-list-data nil
70 "Alist with 'list' data.
71This alist is filled by `guix-list-define-interface' macro.")
72
73(defun guix-list-value (entry-type symbol)
74 "Return SYMBOL's value for ENTRY-TYPE from `guix-list-data'."
75 (symbol-value (guix-assq-value guix-list-data entry-type symbol)))
76
77(defun guix-list-param-title (entry-type param)
78 "Return column title of an ENTRY-TYPE parameter PARAM."
79 (guix-buffer-param-title 'list entry-type param))
80
81(defun guix-list-format (entry-type)
82 "Return column format for ENTRY-TYPE."
83 (guix-list-value entry-type 'format))
84
85(defun guix-list-displayed-params (entry-type)
86 "Return a list of ENTRY-TYPE parameters that should be displayed."
87 (mapcar #'car (guix-list-format entry-type)))
88
89(defun guix-list-sort-key (entry-type)
90 "Return sort key for ENTRY-TYPE."
91 (guix-list-value entry-type 'sort-key))
92
93(defun guix-list-additional-marks (entry-type)
94 "Return alist of additional marks for ENTRY-TYPE."
95 (guix-list-value entry-type 'marks))
96
97(defun guix-list-single-entry? (entry-type)
98 "Return non-nil, if a single entry of ENTRY-TYPE should be listed."
99 (guix-list-value entry-type 'list-single))
100
101(defun guix-list-describe-warning-count (entry-type)
102 "Return the maximum number of ENTRY-TYPE entries to describe."
103 (guix-list-value entry-type 'describe-count))
104
105(defun guix-list-describe-entries (entry-type ids)
106 "Describe ENTRY-TYPE entries with IDS in 'info' buffer"
107 (funcall (guix-list-value entry-type 'describe)
108 ids))
109
110
111;;; Tabulated list internals
112
113(defun guix-list-sort-numerically (column a b)
114 "Compare COLUMN of tabulated entries A and B numerically.
115This function is used for sort predicates for `tabulated-list-format'.
116Return non-nil, if B is bigger than A."
117 (cl-flet ((num (entry)
118 (string-to-number (aref (cadr entry) column))))
119 (> (num b) (num a))))
120
121(defmacro guix-list-define-numerical-sorter (column)
122 "Define numerical sort predicate for COLUMN.
123See `guix-list-sort-numerically' for details."
124 (let ((name (intern (format "guix-list-sort-numerically-%d" column)))
125 (doc (format "\
126Predicate to sort tabulated list by column %d numerically.
127See `guix-list-sort-numerically' for details."
128 column)))
129 `(defun ,name (a b)
130 ,doc
131 (guix-list-sort-numerically ,column a b))))
132
133(defmacro guix-list-define-numerical-sorters (n)
134 "Define numerical sort predicates for columns from 0 to N.
135See `guix-list-define-numerical-sorter' for details."
136 `(progn
137 ,@(mapcar (lambda (i)
138 `(guix-list-define-numerical-sorter ,i))
139 (number-sequence 0 n))))
140
141(guix-list-define-numerical-sorters 9)
142
143(defun guix-list-tabulated-sort-key (entry-type)
144 "Return ENTRY-TYPE sort key for `tabulated-list-sort-key'."
145 (let ((sort-key (guix-list-sort-key entry-type)))
146 (and sort-key
147 (cons (guix-list-param-title entry-type (car sort-key))
148 (cdr sort-key)))))
149
150(defun guix-list-tabulated-vector (entry-type fun)
151 "Call FUN on each column specification for ENTRY-TYPE.
152
153FUN is applied to column specification as arguments (see
154`guix-list-format').
155
156Return a vector made of values of FUN calls."
157 (apply #'vector
158 (mapcar (lambda (col-spec)
159 (apply fun col-spec))
160 (guix-list-format entry-type))))
161
162(defun guix-list-tabulated-format (entry-type)
163 "Return ENTRY-TYPE list specification for `tabulated-list-format'."
164 (guix-list-tabulated-vector
165 entry-type
166 (lambda (param _ &rest rest-spec)
167 (cons (guix-list-param-title entry-type param)
168 rest-spec))))
169
170(defun guix-list-tabulated-entries (entries entry-type)
171 "Return a list of ENTRY-TYPE values for `tabulated-list-entries'."
172 (mapcar (lambda (entry)
173 (list (guix-entry-id entry)
174 (guix-list-tabulated-entry entry entry-type)))
175 entries))
176
177(defun guix-list-tabulated-entry (entry entry-type)
178 "Return array of values for `tabulated-list-entries'.
179Parameters are taken from ENTRY-TYPE ENTRY."
180 (guix-list-tabulated-vector
181 entry-type
182 (lambda (param fun &rest _)
183 (let ((val (guix-entry-value entry param)))
184 (if fun
185 (funcall fun val entry)
186 (guix-get-string val))))))
187
188
189;;; Displaying entries
190
191(defun guix-list-get-display-entries (entry-type &rest args)
192 "Search for entries and show them in a 'list' buffer preferably."
193 (let ((entries (guix-buffer-get-entries 'list entry-type args)))
194 (if (or (null entries) ; = 0
195 (cdr entries) ; > 1
196 (guix-list-single-entry? entry-type)
197 (null (guix-buffer-value 'info entry-type 'show-entries)))
198 (guix-buffer-display-entries entries 'list entry-type args 'add)
199 (if (equal (guix-buffer-value 'info entry-type 'get-entries)
200 (guix-buffer-value 'list entry-type 'get-entries))
201 (guix-buffer-display-entries entries 'info entry-type args 'add)
202 (guix-buffer-get-display-entries 'info entry-type args 'add)))))
203
204(defun guix-list-insert-entries (entries entry-type)
205 "Print ENTRY-TYPE ENTRIES in the current buffer."
206 (setq tabulated-list-entries
207 (guix-list-tabulated-entries entries entry-type))
208 (tabulated-list-print))
209
210(defun guix-list-get-one-line (val &optional _)
211 "Return one-line string from a multi-line string VAL.
212VAL may be nil."
213 (if val
214 (guix-get-one-line val)
215 (guix-get-string nil)))
216
217(defun guix-list-get-time (seconds &optional _)
218 "Return formatted time string from SECONDS."
219 (guix-get-string (guix-get-time-string seconds)
220 'guix-list-time))
221
222(defun guix-list-get-file-name (file-name &optional _)
223 "Return FILE-NAME button specification for `tabulated-list-entries'."
224 (list file-name
225 'face 'guix-list-file-name
226 'action (lambda (btn) (find-file (button-label btn)))
227 'follow-link t
228 'help-echo "Find file"))
229
230(defun guix-list-get-url (url &optional _)
231 "Return URL button specification for `tabulated-list-entries'."
232 (list url
233 'face 'guix-list-url
234 'action (lambda (btn) (browse-url (button-label btn)))
235 'follow-link t
236 'help-echo "Browse URL"))
237
238
239;;; 'List' lines
240
241(defun guix-list-current-id ()
242 "Return ID of the entry at point."
243 (or (tabulated-list-get-id)
244 (user-error "No entry here")))
245
246(defun guix-list-current-entry ()
247 "Return entry at point."
248 (guix-entry-by-id (guix-list-current-id)
249 (guix-buffer-current-entries)))
250
251(defun guix-list-for-each-line (fun &rest args)
252 "Call FUN with ARGS for each entry line."
253 (or (derived-mode-p 'guix-list-mode)
254 (error "The current buffer is not in Guix List mode"))
255 (save-excursion
256 (goto-char (point-min))
257 (while (not (eobp))
258 (apply fun args)
259 (forward-line))))
260
261(defun guix-list-fold-lines (fun init)
262 "Fold over entry lines in the current list buffer.
263Call FUN with RESULT as argument for each line, using INIT as
264the initial value of RESULT. Return the final result."
265 (let ((res init))
266 (guix-list-for-each-line
267 (lambda () (setq res (funcall fun res))))
268 res))
269
270
271;;; Marking and sorting
272
273(defvar-local guix-list-marked nil
274 "List of the marked entries.
275Each element of the list has a form:
276
277 (ID MARK-NAME . ARGS)
278
279ID is an entry ID.
280MARK-NAME is a symbol from `guix-list-marks'.
281ARGS is a list of additional values.")
282
283(defvar-local guix-list-marks nil
284 "Alist of available mark names and mark characters.")
285
286(defvar guix-list-default-marks
287 '((empty . ?\s)
288 (general . ?*))
289 "Alist of default mark names and mark characters.")
290
291(defun guix-list-marks (entry-type)
292 "Return alist of available marks for ENTRY-TYPE."
293 (append guix-list-default-marks
294 (guix-list-additional-marks entry-type)))
295
296(defun guix-list-get-mark (name)
297 "Return mark character by its NAME."
298 (or (guix-assq-value guix-list-marks name)
299 (error "Mark '%S' not found" name)))
300
301(defun guix-list-get-mark-string (name)
302 "Return mark string by its NAME."
303 (string (guix-list-get-mark name)))
304
305(defun guix-list-current-mark ()
306 "Return mark character of the current line."
307 (char-after (line-beginning-position)))
308
309(defun guix-list-get-marked (&rest mark-names)
310 "Return list of specs of entries marked with any mark from MARK-NAMES.
311Entry specs are elements from `guix-list-marked' list.
312If MARK-NAMES are not specified, use all marks from
313`guix-list-marks' except the `empty' one."
314 (or mark-names
315 (setq mark-names
316 (delq 'empty
317 (mapcar #'car guix-list-marks))))
318 (cl-remove-if-not (lambda (assoc)
319 (memq (cadr assoc) mark-names))
320 guix-list-marked))
321
322(defun guix-list-get-marked-args (mark-name)
323 "Return list of (ID . ARGS) elements from lines marked with MARK-NAME.
324See `guix-list-marked' for the meaning of ARGS."
325 (mapcar (lambda (spec)
326 (let ((id (car spec))
327 (args (cddr spec)))
328 (cons id args)))
329 (guix-list-get-marked mark-name)))
330
331(defun guix-list-get-marked-id-list (&rest mark-names)
332 "Return list of IDs of entries marked with any mark from MARK-NAMES.
333See `guix-list-get-marked' for details."
334 (mapcar #'car (apply #'guix-list-get-marked mark-names)))
335
336(defun guix-list--mark (mark-name &optional advance &rest args)
337 "Put a mark on the current line.
338Also add the current entry to `guix-list-marked' using its ID and ARGS.
339MARK-NAME is a symbol from `guix-list-marks'.
340If ADVANCE is non-nil, move forward by one line after marking."
341 (let ((id (guix-list-current-id)))
342 (if (eq mark-name 'empty)
343 (setq guix-list-marked (assq-delete-all id guix-list-marked))
344 (let ((assoc (assq id guix-list-marked))
345 (val (cons mark-name args)))
346 (if assoc
347 (setcdr assoc val)
348 (push (cons id val) guix-list-marked)))))
349 (tabulated-list-put-tag (guix-list-get-mark-string mark-name)
350 advance))
351
352(defun guix-list-mark (&optional arg)
353 "Mark the current line and move to the next line.
354With ARG, mark all lines."
355 (interactive "P")
356 (if arg
357 (guix-list-mark-all)
358 (guix-list--mark 'general t)))
359
360(defun guix-list-mark-all (&optional mark-name)
361 "Mark all lines with MARK-NAME mark.
362MARK-NAME is a symbol from `guix-list-marks'.
363Interactively, put a general mark on all lines."
364 (interactive)
365 (or mark-name (setq mark-name 'general))
366 (guix-list-for-each-line #'guix-list--mark mark-name))
367
368(defun guix-list-unmark (&optional arg)
369 "Unmark the current line and move to the next line.
370With ARG, unmark all lines."
371 (interactive "P")
372 (if arg
373 (guix-list-unmark-all)
374 (guix-list--mark 'empty t)))
375
376(defun guix-list-unmark-backward ()
377 "Move up one line and unmark it."
378 (interactive)
379 (forward-line -1)
380 (guix-list--mark 'empty))
381
382(defun guix-list-unmark-all ()
383 "Unmark all lines."
384 (interactive)
385 (guix-list-mark-all 'empty))
386
387(defun guix-list-restore-marks ()
388 "Put marks according to `guix-list-marked'."
389 (guix-list-for-each-line
390 (lambda ()
391 (let ((mark-name (car (guix-assq-value guix-list-marked
392 (guix-list-current-id)))))
393 (tabulated-list-put-tag
394 (guix-list-get-mark-string (or mark-name 'empty)))))))
395
396(defun guix-list-sort (&optional n)
397 "Sort guix list entries by the column at point.
398With a numeric prefix argument N, sort the Nth column.
399Same as `tabulated-list-sort', but also restore marks after sorting."
400 (interactive "P")
401 (tabulated-list-sort n)
402 (guix-list-restore-marks))
403
404
405;;; Major mode and interface definer
406
407(defvar guix-list-mode-map
408 (let ((map (make-sparse-keymap)))
409 (set-keymap-parent
410 map (make-composed-keymap guix-buffer-map
411 tabulated-list-mode-map))
412 (define-key map (kbd "RET") 'guix-list-describe)
413 (define-key map (kbd "i") 'guix-list-describe)
414 (define-key map (kbd "m") 'guix-list-mark)
415 (define-key map (kbd "*") 'guix-list-mark)
416 (define-key map (kbd "u") 'guix-list-unmark)
417 (define-key map (kbd "DEL") 'guix-list-unmark-backward)
418 (define-key map [remap tabulated-list-sort] 'guix-list-sort)
419 map)
420 "Keymap for `guix-list-mode' buffers.")
421
422(define-derived-mode guix-list-mode tabulated-list-mode "Guix-List"
423 "Parent mode for displaying data in 'list' form.")
424
425(defun guix-list-mode-initialize (entry-type)
426 "Set up the current 'list' buffer for displaying ENTRY-TYPE entries."
427 (setq tabulated-list-padding 2
428 tabulated-list-format (guix-list-tabulated-format entry-type)
429 tabulated-list-sort-key (guix-list-tabulated-sort-key entry-type))
430 (setq-local guix-list-marks (guix-list-marks entry-type))
431 (tabulated-list-init-header))
432
433(defmacro guix-list-define-interface (entry-type &rest args)
434 "Define 'list' interface for displaying ENTRY-TYPE entries.
435Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
436
437Required keywords:
438
439 - `:format' - default value of the generated
440 `guix-ENTRY-TYPE-list-format' variable.
441
442Optional keywords:
443
444 - `:sort-key' - default value of the generated
445 `guix-ENTRY-TYPE-list-sort-key' variable.
446
447 - `:describe-function' - default value of the generated
448 `guix-ENTRY-TYPE-describe-function' variable.
449
450 - `:list-single?' - default value of the generated
451 `guix-ENTRY-TYPE-list-single' variable.
452
453 - `:marks' - default value of the generated
454 `guix-ENTRY-TYPE-list-marks' variable.
455
456The rest keyword arguments are passed to
457`guix-buffer-define-interface' macro."
458 (declare (indent 1))
459 (let* ((entry-type-str (symbol-name entry-type))
460 (prefix (concat "guix-" entry-type-str "-list"))
461 (group (intern prefix))
462 (describe-var (intern (concat prefix "-describe-function")))
463 (describe-count-var (intern (concat prefix
464 "-describe-warning-count")))
465 (format-var (intern (concat prefix "-format")))
466 (sort-key-var (intern (concat prefix "-sort-key")))
467 (list-single-var (intern (concat prefix "-single")))
468 (marks-var (intern (concat prefix "-marks"))))
469 (guix-keyword-args-let args
470 ((show-entries-val :show-entries-function)
471 (describe-val :describe-function)
472 (describe-count-val :describe-count 10)
473 (format-val :format)
474 (sort-key-val :sort-key)
475 (list-single-val :list-single?)
476 (marks-val :marks))
477 `(progn
478 (defcustom ,format-var ,format-val
479 ,(format "\
480List of format values of the displayed columns.
481Each element of the list has a form:
482
483 (PARAM VALUE-FUN WIDTH SORT . PROPS)
484
485PARAM is a name of '%s' entry parameter.
486
487VALUE-FUN may be either nil or a function returning a value that
488will be inserted. The function is called with 2 arguments: the
489first one is the value of the parameter; the second one is an
490entry (alist of parameter names and values).
491
492For the meaning of WIDTH, SORT and PROPS, see
493`tabulated-list-format'."
494 entry-type-str)
495 :type 'sexp
496 :group ',group)
497
498 (defcustom ,sort-key-var ,sort-key-val
499 ,(format "\
500Default sort key for 'list' buffer with '%s' entries.
501Should be nil (no sort) or have a form:
502
503 (PARAM . FLIP)
504
505PARAM is the name of '%s' entry parameter. For the meaning of
506FLIP, see `tabulated-list-sort-key'."
507 entry-type-str entry-type-str)
508 :type '(choice (const :tag "No sort" nil)
509 (cons symbol boolean))
510 :group ',group)
511
512 (defvar ,marks-var ,marks-val
513 ,(format "\
514Alist of additional marks for 'list' buffer with '%s' entries.
515Marks from this list are used along with `guix-list-default-marks'."
516 entry-type-str))
517
518 (defcustom ,list-single-var ,list-single-val
519 ,(format "\
520If non-nil, list '%s' entry even if it is the only matching result.
521If nil, show a single '%s' entry in the 'info' buffer."
522 entry-type-str entry-type-str)
523 :type 'boolean
524 :group ',group)
525
526 (defcustom ,describe-count-var ,describe-count-val
527 ,(format "\
528The maximum number of '%s' entries to describe without a warning.
529If a user wants to describe more than this number of marked
530entries, he will be prompted for confirmation.
531See also `guix-list-describe'."
532 entry-type-str)
533 :type 'integer
534 :group ',group)
535
536 (defvar ,describe-var ,describe-val
537 ,(format "Function used to describe '%s' entries."
538 entry-type-str))
539
540 (guix-alist-put!
541 '((describe . ,describe-var)
542 (describe-count . ,describe-count-var)
543 (format . ,format-var)
544 (sort-key . ,sort-key-var)
545 (list-single . ,list-single-var)
546 (marks . ,marks-var))
547 'guix-list-data ',entry-type)
548
549 ,(if show-entries-val
550 `(guix-buffer-define-interface list ,entry-type
551 :show-entries-function ,show-entries-val
552 ,@%foreign-args)
553
554 (let ((insert-fun (intern (concat prefix "-insert-entries")))
555 (mode-init-fun (intern (concat prefix "-mode-initialize"))))
556 `(progn
557 (defun ,insert-fun (entries)
558 ,(format "\
559Print '%s' ENTRIES in the current 'list' buffer."
560 entry-type-str)
561 (guix-list-insert-entries entries ',entry-type))
562
563 (defun ,mode-init-fun ()
564 ,(format "\
565Set up the current 'list' buffer for displaying '%s' entries."
566 entry-type-str)
567 (guix-list-mode-initialize ',entry-type))
568
569 (guix-buffer-define-interface list ,entry-type
570 :insert-entries-function ',insert-fun
571 :mode-init-function ',mode-init-fun
572 ,@%foreign-args))))))))
573
574
575(defvar guix-list-font-lock-keywords
576 (eval-when-compile
577 `((,(rx "(" (group "guix-list-define-interface")
578 symbol-end)
579 . 1))))
580
581(font-lock-add-keywords 'emacs-lisp-mode guix-list-font-lock-keywords)
582
583(provide 'guix-list)
584
585;;; guix-list.el ends here
diff --git a/emacs/guix-location.el b/emacs/guix-location.el
deleted file mode 100644
index 81396b40173..00000000000
--- a/emacs/guix-location.el
+++ /dev/null
@@ -1,79 +0,0 @@
1;;; guix-location.el --- Package locations
2
3;; Copyright © 2016 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 Location as published by
9;; the Free Software Foundation, either version 3 of the Location, 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 Location for more details.
16
17;; You should have received a copy of the GNU General Public Location
18;; along with this program. If not, see <http://www.gnu.org/locations/>.
19
20;;; Commentary:
21
22;; This file provides the code to work with locations of Guix packages.
23
24;;; Code:
25
26(require 'cl-lib)
27(require 'guix-backend)
28(require 'guix-read)
29(require 'guix-guile)
30
31(defun guix-package-location (id-or-name)
32 "Return location of a package with ID-OR-NAME.
33For the meaning of location, see `guix-find-location'."
34 (guix-eval-read (guix-make-guile-expression
35 'package-location-string id-or-name)))
36
37;;;###autoload
38(defun guix-find-location (location &optional directory)
39 "Go to LOCATION of a package.
40LOCATION is a string of the form:
41
42 \"FILE:LINE:COLUMN\"
43
44If FILE is relative, it is considered to be relative to
45DIRECTORY (`guix-directory' by default).
46
47Interactively, prompt for LOCATION. With prefix argument, prompt
48for DIRECTORY as well."
49 (interactive
50 (list (guix-read-package-location)
51 (guix-read-directory)))
52 (cl-multiple-value-bind (file line column)
53 (split-string location ":")
54 (find-file (expand-file-name file (or directory guix-directory)))
55 (when (and line column)
56 (let ((line (string-to-number line))
57 (column (string-to-number column)))
58 (goto-char (point-min))
59 (forward-line (- line 1))
60 (move-to-column column)
61 (recenter 1)))))
62
63;;;###autoload
64(defun guix-edit (id-or-name &optional directory)
65 "Edit (go to location of) package with ID-OR-NAME.
66See `guix-find-location' for the meaning of package location and
67DIRECTORY.
68Interactively, with prefix argument, prompt for DIRECTORY."
69 (interactive
70 (list (guix-read-package-name)
71 (guix-read-directory)))
72 (let ((loc (guix-package-location id-or-name)))
73 (if loc
74 (guix-find-location loc directory)
75 (message "Couldn't find package location."))))
76
77(provide 'guix-location)
78
79;;; guix-location.el ends here
diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm
deleted file mode 100644
index 040932f3072..00000000000
--- a/emacs/guix-main.scm
+++ /dev/null
@@ -1,1163 +0,0 @@
1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2014, 2015, 2016 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.
24
25;; ‘entries’ procedure is the “entry point” for the elisp side to get
26;; information about packages and generations.
27
28;; Since name/version pair is not necessarily unique, we use
29;; `object-address' to identify a package (for ‘id’ parameter), if
30;; possible. However for the obsolete packages (that can be found in
31;; installed manifest but not in a package directory), ‘id’ parameter is
32;; still "name-version" string. So ‘id’ package parameter in the code
33;; below is either an object-address number or a full-name string.
34
35;;; Code:
36
37(use-modules
38 (ice-9 vlist)
39 (ice-9 match)
40 (ice-9 popen)
41 (srfi srfi-1)
42 (srfi srfi-2)
43 (srfi srfi-11)
44 (srfi srfi-19)
45 (srfi srfi-26)
46 (guix)
47 (guix combinators)
48 (guix git-download)
49 (guix grafts)
50 (guix packages)
51 (guix profiles)
52 (guix licenses)
53 (guix utils)
54 (guix ui)
55 (guix scripts)
56 (guix scripts package)
57 (gnu packages)
58 (gnu system))
59
60(define-syntax-rule (first-or-false lst)
61 (and (not (null? lst))
62 (first lst)))
63
64(define (list-maybe obj)
65 (if (list? obj) obj (list obj)))
66
67(define (output+error thunk)
68 "Call THUNK and return 2 values: output and error output as strings."
69 (let ((output-port (open-output-string))
70 (error-port (open-output-string)))
71 (with-output-to-port output-port
72 (lambda () (with-error-to-port error-port thunk)))
73 (let ((strings (list (get-output-string output-port)
74 (get-output-string error-port))))
75 (close-output-port output-port)
76 (close-output-port error-port)
77 (apply values strings))))
78
79(define (full-name->name+version spec)
80 "Given package specification SPEC with or without output,
81return two values: name and version. For example, for SPEC
82\"foo@0.9.1b:lib\", return \"foo\" and \"0.9.1b\"."
83 (let-values (((name version output)
84 (package-specification->name+version+output spec)))
85 (values name version)))
86
87(define (name+version->full-name name version)
88 (string-append name "@" version))
89
90(define* (make-package-specification name #:optional version output)
91 (let ((full-name (if version
92 (name+version->full-name name version)
93 name)))
94 (if output
95 (string-append full-name ":" output)
96 full-name)))
97
98(define (manifest-entry->name+version+output entry)
99 (values
100 (manifest-entry-name entry)
101 (manifest-entry-version entry)
102 (manifest-entry-output entry)))
103
104(define (manifest-entry->package-specification entry)
105 (call-with-values
106 (lambda () (manifest-entry->name+version+output entry))
107 make-package-specification))
108
109(define (manifest-entries->package-specifications entries)
110 (map manifest-entry->package-specification entries))
111
112(define (profile-package-specifications profile)
113 "Return a list of package specifications for PROFILE."
114 (let ((manifest (profile-manifest profile)))
115 (manifest-entries->package-specifications
116 (manifest-entries manifest))))
117
118(define (profile->specifications+paths profile)
119 "Return a list of package specifications and paths for PROFILE.
120Each element of the list is a list of the package specification and its path."
121 (let ((manifest (profile-manifest profile)))
122 (map (lambda (entry)
123 (list (manifest-entry->package-specification entry)
124 (manifest-entry-item entry)))
125 (manifest-entries manifest))))
126
127(define (profile-difference profile1 profile2)
128 "Return a list of package specifications for outputs installed in PROFILE1
129and not installed in PROFILE2."
130 (let ((specs1 (profile-package-specifications profile1))
131 (specs2 (profile-package-specifications profile2)))
132 (lset-difference string=? specs1 specs2)))
133
134(define (manifest-entries->hash-table entries)
135 "Return a hash table of name keys and lists of matching manifest ENTRIES."
136 (let ((table (make-hash-table (length entries))))
137 (for-each (lambda (entry)
138 (let* ((key (manifest-entry-name entry))
139 (ref (hash-ref table key)))
140 (hash-set! table key
141 (if ref (cons entry ref) (list entry)))))
142 entries)
143 table))
144
145(define (manifest=? m1 m2)
146 (or (eq? m1 m2)
147 (equal? m1 m2)))
148
149(define manifest->hash-table
150 (let ((current-manifest #f)
151 (current-table #f))
152 (lambda (manifest)
153 "Return a hash table of name keys and matching MANIFEST entries."
154 (unless (manifest=? manifest current-manifest)
155 (set! current-manifest manifest)
156 (set! current-table (manifest-entries->hash-table
157 (manifest-entries manifest))))
158 current-table)))
159
160(define* (manifest-entries-by-name manifest name #:optional version output)
161 "Return a list of MANIFEST entries matching NAME, VERSION and OUTPUT."
162 (let ((entries (or (hash-ref (manifest->hash-table manifest) name)
163 '())))
164 (if (or version output)
165 (filter (lambda (entry)
166 (and (or (not version)
167 (equal? version (manifest-entry-version entry)))
168 (or (not output)
169 (equal? output (manifest-entry-output entry)))))
170 entries)
171 entries)))
172
173(define (manifest-entry-by-output entries output)
174 "Return a manifest entry from ENTRIES matching OUTPUT."
175 (find (lambda (entry)
176 (string= output (manifest-entry-output entry)))
177 entries))
178
179(define (fold-manifest-by-name manifest proc init)
180 "Fold over MANIFEST entries.
181Call (PROC NAME VERSION ENTRIES RESULT), using INIT as the initial value
182of RESULT. ENTRIES is a list of manifest entries with NAME/VERSION."
183 (hash-fold (lambda (name entries res)
184 (proc name (manifest-entry-version (car entries))
185 entries res))
186 init
187 (manifest->hash-table manifest)))
188
189(define* (object-transformer param-alist #:optional (params '()))
190 "Return procedure transforming objects into alist of parameter/value pairs.
191
192PARAM-ALIST is alist of available parameters (symbols) and procedures
193returning values of these parameters. Each procedure is applied to
194objects.
195
196PARAMS is list of parameters from PARAM-ALIST that should be returned by
197a resulting procedure. If PARAMS is not specified or is an empty list,
198use all available parameters.
199
200Example:
201
202 (let* ((alist `((plus1 . ,1+) (minus1 . ,1-) (mul2 . ,(cut * 2 <>))))
203 (number->alist (object-transformer alist '(plus1 mul2))))
204 (number->alist 8))
205 =>
206 ((plus1 . 9) (mul2 . 16))
207"
208 (let* ((use-all-params (null? params))
209 (alist (filter-map (match-lambda
210 ((param . proc)
211 (and (or use-all-params
212 (memq param params))
213 (cons param proc)))
214 (_ #f))
215 param-alist)))
216 (lambda objects
217 (map (match-lambda
218 ((param . proc)
219 (cons param (apply proc objects))))
220 alist))))
221
222(define %manifest-entry-param-alist
223 `((output . ,manifest-entry-output)
224 (path . ,manifest-entry-item)
225 (dependencies . ,manifest-entry-dependencies)))
226
227(define manifest-entry->sexp
228 (object-transformer %manifest-entry-param-alist))
229
230(define (manifest-entries->sexps entries)
231 (map manifest-entry->sexp entries))
232
233(define (package-inputs-names inputs)
234 "Return a list of full names of the packages from package INPUTS."
235 (filter-map (match-lambda
236 ((_ (? package? package))
237 (make-package-specification (package-name package)
238 (package-version package)))
239 ((_ (? package? package) output)
240 (make-package-specification (package-name package)
241 (package-version package)
242 output))
243 (_ #f))
244 inputs))
245
246(define (package-license-names package)
247 "Return a list of license names of the PACKAGE."
248 (filter-map (lambda (license)
249 (and (license? license)
250 (license-name license)))
251 (list-maybe (package-license package))))
252
253(define (package-source-names package)
254 "Return a list of source names (URLs) of the PACKAGE."
255 (let ((source (package-source package)))
256 (and (origin? source)
257 (filter-map (lambda (uri)
258 (cond ((string? uri)
259 uri)
260 ((git-reference? uri)
261 (git-reference-url uri))
262 (else "Unknown source type")))
263 (list-maybe (origin-uri source))))))
264
265(define (package-unique? package)
266 "Return #t if PACKAGE is a single package with such name/version."
267 (match (packages-by-name (package-name package)
268 (package-version package))
269 ((package) #t)
270 (_ #f)))
271
272(define %package-param-alist
273 `((id . ,object-address)
274 (package-id . ,object-address)
275 (name . ,package-name)
276 (version . ,package-version)
277 (license . ,package-license-names)
278 (source . ,package-source-names)
279 (synopsis . ,package-synopsis)
280 (description . ,package-description-string)
281 (home-url . ,package-home-page)
282 (outputs . ,package-outputs)
283 (systems . ,package-supported-systems)
284 (non-unique . ,(negate package-unique?))
285 (inputs . ,(lambda (pkg)
286 (package-inputs-names
287 (package-inputs pkg))))
288 (native-inputs . ,(lambda (pkg)
289 (package-inputs-names
290 (package-native-inputs pkg))))
291 (propagated-inputs . ,(lambda (pkg)
292 (package-inputs-names
293 (package-propagated-inputs pkg))))
294 (location . ,(lambda (pkg)
295 (location->string (package-location pkg))))))
296
297(define (package-param package param)
298 "Return a value of a PACKAGE PARAM."
299 (and=> (assq-ref %package-param-alist param)
300 (cut <> package)))
301
302
303;;; Finding packages.
304
305(define-values (package-by-address
306 register-package)
307 (let ((table (delay (fold-packages
308 (lambda (package table)
309 (vhash-consq (object-address package)
310 package table))
311 vlist-null))))
312 (values
313 (lambda (address)
314 "Return package by its object ADDRESS."
315 (match (vhash-assq address (force table))
316 ((_ . package) package)
317 (_ #f)))
318 (lambda (package)
319 "Register PACKAGE by its 'object-address', so that later
320'package-by-address' can be used to access it."
321 (let ((table* (force table)))
322 (set! table
323 (delay (vhash-consq (object-address package)
324 package table*))))))))
325
326(define packages-by-name+version
327 (let ((table (delay (fold-packages
328 (lambda (package table)
329 (let ((file (location-file
330 (package-location package))))
331 (vhash-cons (cons (package-name package)
332 (package-version package))
333 package table)))
334 vlist-null))))
335 (lambda (name version)
336 "Return packages matching NAME and VERSION."
337 (vhash-fold* cons '() (cons name version) (force table)))))
338
339(define (packages-by-full-name full-name)
340 (call-with-values
341 (lambda () (full-name->name+version full-name))
342 packages-by-name+version))
343
344(define (packages-by-id id)
345 (if (integer? id)
346 (let ((pkg (package-by-address id)))
347 (if pkg (list pkg) '()))
348 (packages-by-full-name id)))
349
350(define (id->name+version id)
351 (if (integer? id)
352 (and=> (package-by-address id)
353 (lambda (pkg)
354 (values (package-name pkg)
355 (package-version pkg))))
356 (full-name->name+version id)))
357
358(define (package-by-id id)
359 (first-or-false (packages-by-id id)))
360
361(define (newest-package-by-id id)
362 (and=> (id->name+version id)
363 (lambda (name)
364 (first-or-false (find-best-packages-by-name name #f)))))
365
366(define (matching-packages predicate)
367 (fold-packages (lambda (pkg res)
368 (if (predicate pkg)
369 (cons pkg res)
370 res))
371 '()))
372
373(define (filter-packages-by-output packages output)
374 (filter (lambda (package)
375 (member output (package-outputs package)))
376 packages))
377
378(define* (packages-by-name name #:optional version output)
379 "Return a list of packages matching NAME, VERSION and OUTPUT."
380 (let ((packages (if version
381 (packages-by-name+version name version)
382 (matching-packages
383 (lambda (pkg) (string=? name (package-name pkg)))))))
384 (if output
385 (filter-packages-by-output packages output)
386 packages)))
387
388(define (manifest-entry->packages entry)
389 (call-with-values
390 (lambda () (manifest-entry->name+version+output entry))
391 packages-by-name))
392
393(define (packages-by-regexp regexp match-params)
394 "Return a list of packages matching REGEXP string.
395MATCH-PARAMS is a list of parameters that REGEXP can match."
396 (define (package-match? package regexp)
397 (any (lambda (param)
398 (let ((val (package-param package param)))
399 (and (string? val) (regexp-exec regexp val))))
400 match-params))
401
402 (let ((re (make-regexp regexp regexp/icase)))
403 (matching-packages (cut package-match? <> re))))
404
405(define (packages-by-license license)
406 "Return a list of packages with LICENSE."
407 (matching-packages
408 (lambda (package)
409 (memq license (list-maybe (package-license package))))))
410
411(define (all-available-packages)
412 "Return a list of all available packages."
413 (matching-packages (const #t)))
414
415(define (newest-available-packages)
416 "Return a list of the newest available packages."
417 (vhash-fold (lambda (name elem res)
418 (match elem
419 ((_ newest pkgs ...)
420 (cons newest res))))
421 '()
422 (find-newest-available-packages)))
423
424(define (packages-from-file file)
425 "Return a list of packages from FILE."
426 (let ((package (load (canonicalize-path file))))
427 (if (package? package)
428 (begin
429 (register-package package)
430 (list package))
431 '())))
432
433
434;;; Making package/output patterns.
435
436(define (specification->package-pattern specification)
437 (call-with-values
438 (lambda ()
439 (full-name->name+version specification))
440 list))
441
442(define (specification->output-pattern specification)
443 (call-with-values
444 (lambda ()
445 (package-specification->name+version+output specification #f))
446 list))
447
448(define (id->package-pattern id)
449 (if (integer? id)
450 (package-by-address id)
451 (specification->package-pattern id)))
452
453(define (id->output-pattern id)
454 "Return an output pattern by output ID.
455ID should be '<package-address>:<output>' or '<name>-<version>:<output>'."
456 (let-values (((name version output)
457 (package-specification->name+version+output id)))
458 (if version
459 (list name version output)
460 (list (package-by-address (string->number name))
461 output))))
462
463(define (specifications->package-patterns . specifications)
464 (map specification->package-pattern specifications))
465
466(define (specifications->output-patterns . specifications)
467 (map specification->output-pattern specifications))
468
469(define (ids->package-patterns . ids)
470 (map id->package-pattern ids))
471
472(define (ids->output-patterns . ids)
473 (map id->output-pattern ids))
474
475(define* (manifest-patterns-result packages res obsolete-pattern
476 #:optional installed-pattern)
477 "Auxiliary procedure for 'manifest-package-patterns' and
478'manifest-output-patterns'."
479 (if (null? packages)
480 (cons (obsolete-pattern) res)
481 (if installed-pattern
482 ;; We don't need duplicates for a list of installed packages,
483 ;; so just take any (car) package.
484 (cons (installed-pattern (car packages)) res)
485 res)))
486
487(define* (manifest-package-patterns manifest #:optional obsolete-only?)
488 "Return a list of package patterns for MANIFEST entries.
489If OBSOLETE-ONLY? is #f, use all entries, otherwise make patterns only
490for obsolete packages."
491 (fold-manifest-by-name
492 manifest
493 (lambda (name version entries res)
494 (manifest-patterns-result (packages-by-name name version)
495 res
496 (lambda () (list name version entries))
497 (and (not obsolete-only?)
498 (cut list <> entries))))
499 '()))
500
501(define* (manifest-output-patterns manifest #:optional obsolete-only?)
502 "Return a list of output patterns for MANIFEST entries.
503If OBSOLETE-ONLY? is #f, use all entries, otherwise make patterns only
504for obsolete packages."
505 (fold (lambda (entry res)
506 (manifest-patterns-result (manifest-entry->packages entry)
507 res
508 (lambda () entry)
509 (and (not obsolete-only?)
510 (cut list <> entry))))
511 '()
512 (manifest-entries manifest)))
513
514(define (obsolete-package-patterns manifest)
515 (manifest-package-patterns manifest #t))
516
517(define (obsolete-output-patterns manifest)
518 (manifest-output-patterns manifest #t))
519
520
521;;; Transforming package/output patterns into alists.
522
523(define (obsolete-package-sexp name version entries)
524 "Return an alist with information about obsolete package.
525ENTRIES is a list of installed manifest entries."
526 `((id . ,(name+version->full-name name version))
527 (name . ,name)
528 (version . ,version)
529 (outputs . ,(map manifest-entry-output entries))
530 (obsolete . #t)
531 (installed . ,(manifest-entries->sexps entries))))
532
533(define (package-pattern-transformer manifest params)
534 "Return 'package-pattern->package-sexps' procedure."
535 (define package->sexp
536 (object-transformer %package-param-alist params))
537
538 (define* (sexp-by-package package #:optional
539 (entries (manifest-entries-by-name
540 manifest
541 (package-name package)
542 (package-version package))))
543 (cons (cons 'installed (manifest-entries->sexps entries))
544 (package->sexp package)))
545
546 (define (->sexps pattern)
547 (match pattern
548 ((? package? package)
549 (list (sexp-by-package package)))
550 (((? package? package) entries)
551 (list (sexp-by-package package entries)))
552 ((name version entries)
553 (list (obsolete-package-sexp
554 name version entries)))
555 ((name version)
556 (let ((packages (packages-by-name name version)))
557 (if (null? packages)
558 (let ((entries (manifest-entries-by-name
559 manifest name version)))
560 (if (null? entries)
561 '()
562 (list (obsolete-package-sexp
563 name version entries))))
564 (map sexp-by-package packages))))
565 (_ '())))
566
567 ->sexps)
568
569(define (output-pattern-transformer manifest params)
570 "Return 'output-pattern->output-sexps' procedure."
571 (define package->sexp
572 (object-transformer (alist-delete 'id %package-param-alist)
573 params))
574
575 (define manifest-entry->sexp
576 (object-transformer (alist-delete 'output %manifest-entry-param-alist)
577 params))
578
579 (define* (output-sexp pkg-alist pkg-address output
580 #:optional entry)
581 (let ((entry-alist (if entry
582 (manifest-entry->sexp entry)
583 '()))
584 (base `((id . ,(string-append
585 (number->string pkg-address)
586 ":" output))
587 (output . ,output)
588 (installed . ,(->bool entry)))))
589 (append entry-alist base pkg-alist)))
590
591 (define (obsolete-output-sexp entry)
592 (let-values (((name version output)
593 (manifest-entry->name+version+output entry)))
594 (let ((base `((id . ,(make-package-specification
595 name version output))
596 (package-id . ,(name+version->full-name name version))
597 (name . ,name)
598 (version . ,version)
599 (output . ,output)
600 (obsolete . #t)
601 (installed . #t))))
602 (append (manifest-entry->sexp entry) base))))
603
604 (define* (sexps-by-package package #:optional output
605 (entries (manifest-entries-by-name
606 manifest
607 (package-name package)
608 (package-version package))))
609 ;; Assuming that PACKAGE has this OUTPUT.
610 (let ((pkg-alist (package->sexp package))
611 (address (object-address package))
612 (outputs (if output
613 (list output)
614 (package-outputs package))))
615 (map (lambda (output)
616 (output-sexp pkg-alist address output
617 (manifest-entry-by-output entries output)))
618 outputs)))
619
620 (define* (sexps-by-manifest-entry entry #:optional
621 (packages (manifest-entry->packages
622 entry)))
623 (if (null? packages)
624 (list (obsolete-output-sexp entry))
625 (map (lambda (package)
626 (output-sexp (package->sexp package)
627 (object-address package)
628 (manifest-entry-output entry)
629 entry))
630 packages)))
631
632 (define (->sexps pattern)
633 (match pattern
634 ((? package? package)
635 (sexps-by-package package))
636 ((package (? string? output))
637 (sexps-by-package package output))
638 ((? manifest-entry? entry)
639 (list (obsolete-output-sexp entry)))
640 ((package entry)
641 (sexps-by-manifest-entry entry (list package)))
642 ((name version output)
643 (let ((packages (packages-by-name name version output)))
644 (if (null? packages)
645 (let ((entries (manifest-entries-by-name
646 manifest name version output)))
647 (append-map (cut sexps-by-manifest-entry <>)
648 entries))
649 (append-map (cut sexps-by-package <> output)
650 packages))))
651 (_ '())))
652
653 ->sexps)
654
655(define (entry-type-error entry-type)
656 (error (format #f "Wrong entry-type '~a'" entry-type)))
657
658(define (search-type-error entry-type search-type)
659 (error (format #f "Wrong search type '~a' for entry-type '~a'"
660 search-type entry-type)))
661
662(define %pattern-transformers
663 `((package . ,package-pattern-transformer)
664 (output . ,output-pattern-transformer)))
665
666(define (pattern-transformer entry-type)
667 (assq-ref %pattern-transformers entry-type))
668
669;; All procedures from inner alists are called with (MANIFEST . SEARCH-VALS)
670;; as arguments; see `package/output-sexps'.
671(define %patterns-makers
672 (let* ((apply-to-rest (lambda (proc)
673 (lambda (_ . rest) (apply proc rest))))
674 (apply-to-first (lambda (proc)
675 (lambda (first . _) (proc first))))
676 (manifest-package-proc (apply-to-first manifest-package-patterns))
677 (manifest-output-proc (apply-to-first manifest-output-patterns))
678 (regexp-proc (lambda (_ regexp params . __)
679 (packages-by-regexp regexp params)))
680 (license-proc (lambda (_ license-name)
681 (packages-by-license
682 (lookup-license license-name))))
683 (location-proc (lambda (_ location)
684 (packages-by-location-file location)))
685 (file-proc (lambda (_ file)
686 (packages-from-file file)))
687 (all-proc (lambda _ (all-available-packages)))
688 (newest-proc (lambda _ (newest-available-packages))))
689 `((package
690 (id . ,(apply-to-rest ids->package-patterns))
691 (name . ,(apply-to-rest specifications->package-patterns))
692 (installed . ,manifest-package-proc)
693 (obsolete . ,(apply-to-first obsolete-package-patterns))
694 (regexp . ,regexp-proc)
695 (license . ,license-proc)
696 (location . ,location-proc)
697 (from-file . ,file-proc)
698 (all-available . ,all-proc)
699 (newest-available . ,newest-proc))
700 (output
701 (id . ,(apply-to-rest ids->output-patterns))
702 (name . ,(apply-to-rest specifications->output-patterns))
703 (installed . ,manifest-output-proc)
704 (obsolete . ,(apply-to-first obsolete-output-patterns))
705 (regexp . ,regexp-proc)
706 (license . ,license-proc)
707 (location . ,location-proc)
708 (from-file . ,file-proc)
709 (all-available . ,all-proc)
710 (newest-available . ,newest-proc)))))
711
712(define (patterns-maker entry-type search-type)
713 (or (and=> (assq-ref %patterns-makers entry-type)
714 (cut assq-ref <> search-type))
715 (search-type-error entry-type search-type)))
716
717(define (package/output-sexps profile params entry-type
718 search-type search-vals)
719 "Return information about packages or package outputs.
720See 'entry-sexps' for details."
721 (let* ((manifest (profile-manifest profile))
722 (patterns (if (and (eq? entry-type 'output)
723 (eq? search-type 'profile-diff))
724 (match search-vals
725 ((p1 p2)
726 (map specification->output-pattern
727 (profile-difference p1 p2)))
728 (_ '()))
729 (apply (patterns-maker entry-type search-type)
730 manifest search-vals)))
731 (->sexps ((pattern-transformer entry-type) manifest params)))
732 (append-map ->sexps patterns)))
733
734
735;;; Getting information about generations.
736
737(define (generation-param-alist profile)
738 "Return an alist of generation parameters and procedures for PROFILE."
739 (let ((current (generation-number profile)))
740 `((id . ,identity)
741 (number . ,identity)
742 (prev-number . ,(cut previous-generation-number profile <>))
743 (current . ,(cut = current <>))
744 (path . ,(cut generation-file-name profile <>))
745 (time . ,(lambda (gen)
746 (time-second (generation-time profile gen)))))))
747
748(define (matching-generations profile predicate)
749 "Return a list of PROFILE generations matching PREDICATE."
750 (filter predicate (profile-generations profile)))
751
752(define (last-generations profile number)
753 "Return a list of last NUMBER generations.
754If NUMBER is 0 or less, return all generations."
755 (let ((generations (profile-generations profile))
756 (number (if (<= number 0) +inf.0 number)))
757 (if (> (length generations) number)
758 (list-head (reverse generations) number)
759 generations)))
760
761(define (find-generations profile search-type search-vals)
762 "Find PROFILE's generations matching SEARCH-TYPE and SEARCH-VALS."
763 (case search-type
764 ((id)
765 (matching-generations profile (cut memq <> search-vals)))
766 ((last)
767 (last-generations profile (car search-vals)))
768 ((all)
769 (last-generations profile +inf.0))
770 ((time)
771 (match search-vals
772 ((from to)
773 (matching-generations
774 profile
775 (lambda (gen)
776 (let ((time (time-second (generation-time profile gen))))
777 (< from time to)))))
778 (_ '())))
779 (else (search-type-error "generation" search-type))))
780
781(define (generation-sexps profile params search-type search-vals)
782 "Return information about generations.
783See 'entry-sexps' for details."
784 (let ((generations (find-generations profile search-type search-vals))
785 (->sexp (object-transformer (generation-param-alist profile)
786 params)))
787 (map ->sexp generations)))
788
789(define system-generation-boot-parameters
790 (memoize
791 (lambda (profile generation)
792 "Return boot parameters for PROFILE's system GENERATION."
793 (let* ((gen-file (generation-file-name profile generation))
794 (param-file (string-append gen-file "/parameters")))
795 (call-with-input-file param-file read-boot-parameters)))))
796
797(define (system-generation-param-alist profile)
798 "Return an alist of system generation parameters and procedures for
799PROFILE."
800 (append (generation-param-alist profile)
801 `((label . ,(lambda (gen)
802 (boot-parameters-label
803 (system-generation-boot-parameters
804 profile gen))))
805 (root-device . ,(lambda (gen)
806 (boot-parameters-root-device
807 (system-generation-boot-parameters
808 profile gen))))
809 (kernel . ,(lambda (gen)
810 (boot-parameters-kernel
811 (system-generation-boot-parameters
812 profile gen)))))))
813
814(define (system-generation-sexps profile params search-type search-vals)
815 "Return an alist with information about system generations."
816 (let ((generations (find-generations profile search-type search-vals))
817 (->sexp (object-transformer (system-generation-param-alist profile)
818 params)))
819 (map ->sexp generations)))
820
821
822;;; Getting package/output/generation entries (alists).
823
824(define (entries profile params entry-type search-type search-vals)
825 "Return information about entries.
826
827ENTRY-TYPE is a symbol defining a type of returning information. Should
828be: 'package', 'output' or 'generation'.
829
830SEARCH-TYPE and SEARCH-VALS define how to get the information.
831SEARCH-TYPE should be one of the following symbols:
832
833- If ENTRY-TYPE is 'package' or 'output':
834 'id', 'name', 'regexp', 'all-available', 'newest-available',
835 'installed', 'obsolete', 'generation'.
836
837- If ENTRY-TYPE is 'generation':
838 'id', 'last', 'all', 'time'.
839
840PARAMS is a list of parameters for receiving. If it is an empty list,
841get information with all available parameters, which are:
842
843- If ENTRY-TYPE is 'package':
844 'id', 'name', 'version', 'outputs', 'license', 'synopsis',
845 'description', 'home-url', 'inputs', 'native-inputs',
846 'propagated-inputs', 'location', 'installed'.
847
848- If ENTRY-TYPE is 'output':
849 'id', 'package-id', 'name', 'version', 'output', 'license',
850 'synopsis', 'description', 'home-url', 'inputs', 'native-inputs',
851 'propagated-inputs', 'location', 'installed', 'path', 'dependencies'.
852
853- If ENTRY-TYPE is 'generation':
854 'id', 'number', 'prev-number', 'path', 'time'.
855
856Returning value is a list of alists. Each alist consists of
857parameter/value pairs."
858 (case entry-type
859 ((package output)
860 (package/output-sexps profile params entry-type
861 search-type search-vals))
862 ((generation)
863 (generation-sexps profile params
864 search-type search-vals))
865 ((system-generation)
866 (system-generation-sexps profile params
867 search-type search-vals))
868 (else (entry-type-error entry-type))))
869
870
871;;; Package actions.
872
873(define* (package->manifest-entry* package #:optional output)
874 (and package
875 (package->manifest-entry package output)))
876
877(define* (make-install-manifest-entries id #:optional output)
878 (package->manifest-entry* (package-by-id id) output))
879
880(define* (make-upgrade-manifest-entries id #:optional output)
881 (package->manifest-entry* (newest-package-by-id id) output))
882
883(define* (make-manifest-pattern id #:optional output)
884 "Make manifest pattern from a package ID and OUTPUT."
885 (let-values (((name version)
886 (id->name+version id)))
887 (and name version
888 (manifest-pattern
889 (name name)
890 (version version)
891 (output output)))))
892
893(define (convert-action-pattern pattern proc)
894 "Convert action PATTERN into a list of objects returned by PROC.
895PROC is called: (PROC ID) or (PROC ID OUTPUT)."
896 (match pattern
897 ((id . outputs)
898 (if (null? outputs)
899 (let ((obj (proc id)))
900 (if obj (list obj) '()))
901 (filter-map (cut proc id <>)
902 outputs)))
903 (_ '())))
904
905(define (convert-action-patterns patterns proc)
906 (append-map (cut convert-action-pattern <> proc)
907 patterns))
908
909(define* (process-package-actions
910 profile #:key (install '()) (upgrade '()) (remove '())
911 (use-substitutes? #t) dry-run?)
912 "Perform package actions.
913
914INSTALL, UPGRADE, REMOVE are lists of 'package action patterns'.
915Each pattern should have the following form:
916
917 (ID . OUTPUTS)
918
919ID is an object address or a full-name of a package.
920OUTPUTS is a list of package outputs (may be an empty list)."
921 (format #t "The process begins ...~%")
922 (let* ((install (append
923 (convert-action-patterns
924 install make-install-manifest-entries)
925 (convert-action-patterns
926 upgrade make-upgrade-manifest-entries)))
927 (remove (convert-action-patterns remove make-manifest-pattern))
928 (transaction (manifest-transaction (install install)
929 (remove remove)))
930 (manifest (profile-manifest profile))
931 (new-manifest (manifest-perform-transaction
932 manifest transaction)))
933 (unless (and (null? install) (null? remove))
934 (parameterize ((%graft? (not dry-run?)))
935 (with-store store
936 (set-build-options store
937 #:print-build-trace #f
938 #:use-substitutes? use-substitutes?)
939 (show-manifest-transaction store manifest transaction
940 #:dry-run? dry-run?)
941 (build-and-use-profile store profile new-manifest
942 #:use-substitutes? use-substitutes?
943 #:dry-run? dry-run?))))))
944
945(define (delete-generations* profile generations)
946 "Delete GENERATIONS from PROFILE.
947GENERATIONS is a list of generation numbers."
948 (with-store store
949 (delete-generations store profile generations)))
950
951(define (package-location-string id-or-name)
952 "Return a location string of a package with ID-OR-NAME."
953 (and=> (or (package-by-id id-or-name)
954 (match (packages-by-name id-or-name)
955 (() #f)
956 ((package _ ...) package)))
957 (compose location->string package-location)))
958
959(define (package-store-path package-id)
960 "Return a list of store directories of outputs of package PACKAGE-ID."
961 (match (package-by-id package-id)
962 (#f '())
963 (package
964 (with-store store
965 (map (match-lambda
966 ((_ . drv)
967 (derivation-output-path drv)))
968 (derivation-outputs (package-derivation store package)))))))
969
970(define (package-source-derivation->store-path derivation)
971 "Return a store path of the package source DERIVATION."
972 (match (derivation-outputs derivation)
973 ;; Source derivation is always (("out" . derivation)).
974 (((_ . output-drv))
975 (derivation-output-path output-drv))
976 (_ #f)))
977
978(define (package-source-path package-id)
979 "Return a store file path to a source of a package PACKAGE-ID."
980 (and-let* ((package (package-by-id package-id))
981 (source (package-source package)))
982 (with-store store
983 (package-source-derivation->store-path
984 (package-source-derivation store source)))))
985
986(define* (package-source-build-derivation package-id #:key dry-run?
987 (use-substitutes? #t))
988 "Build source derivation of a package PACKAGE-ID."
989 (and-let* ((package (package-by-id package-id))
990 (source (package-source package)))
991 (with-store store
992 (let* ((derivation (package-source-derivation store source))
993 (derivations (list derivation)))
994 (set-build-options store
995 #:print-build-trace #f
996 #:use-substitutes? use-substitutes?)
997 (show-what-to-build store derivations
998 #:use-substitutes? use-substitutes?
999 #:dry-run? dry-run?)
1000 (unless dry-run?
1001 (build-derivations store derivations))
1002 (format #t "The source store path: ~a~%"
1003 (package-source-derivation->store-path derivation))))))
1004
1005(define (package-build-log-file package-id)
1006 "Return the build log file of a package PACKAGE-ID.
1007Return #f if the build log is not found."
1008 (and-let* ((package (package-by-id package-id)))
1009 (with-store store
1010 (let* ((derivation (package-derivation store package))
1011 (file (derivation-file-name derivation)))
1012 (or (log-file store file)
1013 ((@@ (guix scripts build) log-url) store file))))))
1014
1015
1016;;; Executing guix commands
1017
1018(define (guix-command . args)
1019 "Run 'guix ARGS ...' command."
1020 (catch 'quit
1021 (lambda () (apply run-guix args))
1022 (const #t)))
1023
1024(define (guix-command-output . args)
1025 "Return 2 strings with 'guix ARGS ...' output and error output."
1026 (output+error
1027 (lambda ()
1028 (parameterize ((guix-warning-port (current-error-port)))
1029 (apply guix-command args)))))
1030
1031(define (help-string . commands)
1032 "Return string with 'guix COMMANDS ... --help' output."
1033 (apply guix-command-output `(,@commands "--help")))
1034
1035(define (pipe-guix-output guix-args command-args)
1036 "Run 'guix GUIX-ARGS ...' command and pipe its output to a shell command
1037defined by COMMAND-ARGS.
1038Return #t if the shell command was executed successfully."
1039 (let ((pipe (apply open-pipe* OPEN_WRITE command-args)))
1040 (with-output-to-port pipe
1041 (lambda () (apply guix-command guix-args)))
1042 (zero? (status:exit-val (close-pipe pipe)))))
1043
1044
1045;;; Lists of packages, lint checkers, etc.
1046
1047(define (graph-type-names)
1048 "Return a list of names of available graph node types."
1049 (map (@ (guix graph) node-type-name)
1050 (@ (guix scripts graph) %node-types)))
1051
1052(define (refresh-updater-names)
1053 "Return a list of names of available refresh updater types."
1054 (map (@ (guix upstream) upstream-updater-name)
1055 (@ (guix scripts refresh) %updaters)))
1056
1057(define (lint-checker-names)
1058 "Return a list of names of available lint checkers."
1059 (map (lambda (checker)
1060 (symbol->string ((@ (guix scripts lint) lint-checker-name)
1061 checker)))
1062 (@ (guix scripts lint) %checkers)))
1063
1064(define (package-names)
1065 "Return a list of names of available packages."
1066 (delete-duplicates
1067 (fold-packages (lambda (pkg res)
1068 (cons (package-name pkg) res))
1069 '())))
1070
1071;; See the comment to 'guix-package-names' function in "guix-popup.el".
1072(define (package-names-lists)
1073 (map list (package-names)))
1074
1075
1076;;; Licenses
1077
1078(define %licenses
1079 (delay
1080 (filter license?
1081 (module-map (lambda (_ var)
1082 (variable-ref var))
1083 (resolve-interface '(guix licenses))))))
1084
1085(define (licenses)
1086 (force %licenses))
1087
1088(define (license-names)
1089 "Return a list of names of available licenses."
1090 (map license-name (licenses)))
1091
1092(define lookup-license
1093 (memoize
1094 (lambda (name)
1095 "Return a license by its name."
1096 (find (lambda (l)
1097 (string=? name (license-name l)))
1098 (licenses)))))
1099
1100(define (lookup-license-uri name)
1101 "Return a license URI by its name."
1102 (and=> (lookup-license name)
1103 license-uri))
1104
1105(define %license-param-alist
1106 `((id . ,license-name)
1107 (name . ,license-name)
1108 (url . ,license-uri)
1109 (comment . ,license-comment)))
1110
1111(define license->sexp
1112 (object-transformer %license-param-alist))
1113
1114(define (find-licenses search-type . search-values)
1115 "Return a list of licenses depending on SEARCH-TYPE and SEARCH-VALUES."
1116 (case search-type
1117 ((id name)
1118 (let ((names search-values))
1119 (filter-map lookup-license names)))
1120 ((all)
1121 (licenses))))
1122
1123(define (license-entries search-type . search-values)
1124 (map license->sexp
1125 (apply find-licenses search-type search-values)))
1126
1127
1128;;; Package locations
1129
1130(define-values (packages-by-location-file
1131 package-location-files)
1132 (let* ((table (delay (fold-packages
1133 (lambda (package table)
1134 (let ((file (location-file
1135 (package-location package))))
1136 (vhash-cons file package table)))
1137 vlist-null)))
1138 (files (delay (vhash-fold
1139 (lambda (file _ result)
1140 (if (member file result)
1141 result
1142 (cons file result)))
1143 '()
1144 (force table)))))
1145 (values
1146 (lambda (file)
1147 "Return the (possibly empty) list of packages defined in location FILE."
1148 (vhash-fold* cons '() file (force table)))
1149 (lambda ()
1150 "Return the list of file names of all package locations."
1151 (force files)))))
1152
1153(define %package-location-param-alist
1154 `((id . ,identity)
1155 (location . ,identity)
1156 (number-of-packages . ,(lambda (location)
1157 (length (packages-by-location-file location))))))
1158
1159(define package-location->sexp
1160 (object-transformer %package-location-param-alist))
1161
1162(define (package-location-entries)
1163 (map package-location->sexp (package-location-files)))
diff --git a/emacs/guix-messages.el b/emacs/guix-messages.el
deleted file mode 100644
index 52436af9e4f..00000000000
--- a/emacs/guix-messages.el
+++ /dev/null
@@ -1,247 +0,0 @@
1;;; guix-messages.el --- Minibuffer messages
2
3;; Copyright © 2014, 2015 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 `guix-result-message' function used to show a
23;; minibuffer message after displaying packages/generations in a
24;; list/info buffer.
25
26;;; Code:
27
28(require 'cl-lib)
29(require 'guix-utils)
30
31(defvar guix-messages
32 `((package
33 (id
34 ,(lambda (_ entries ids)
35 (guix-message-packages-by-id entries 'package ids)))
36 (name
37 ,(lambda (_ entries names)
38 (guix-message-packages-by-name entries 'package names)))
39 (license
40 ,(lambda (_ entries licenses)
41 (apply #'guix-message-packages-by-license
42 entries 'package licenses)))
43 (location
44 ,(lambda (_ entries locations)
45 (apply #'guix-message-packages-by-location
46 entries 'package locations)))
47 (from-file
48 (0 "No package in file '%s'." val)
49 (1 "Package from file '%s'." val))
50 (regexp
51 (0 "No packages matching '%s'." val)
52 (1 "A single package matching '%s'." val)
53 (many "%d packages matching '%s'." count val))
54 (all-available
55 (0 "No packages are available for some reason.")
56 (1 "A single available package (that's strange).")
57 (many "%d available packages." count))
58 (newest-available
59 (0 "No packages are available for some reason.")
60 (1 "A single newest available package (that's strange).")
61 (many "%d newest available packages." count))
62 (installed
63 (0 "No packages installed in profile '%s'." profile)
64 (1 "A single package installed in profile '%s'." profile)
65 (many "%d packages installed in profile '%s'." count profile))
66 (obsolete
67 (0 "No obsolete packages in profile '%s'." profile)
68 (1 "A single obsolete package in profile '%s'." profile)
69 (many "%d obsolete packages in profile '%s'." count profile)))
70
71 (output
72 (id
73 ,(lambda (_ entries ids)
74 (guix-message-packages-by-id entries 'output ids)))
75 (name
76 ,(lambda (_ entries names)
77 (guix-message-packages-by-name entries 'output names)))
78 (license
79 ,(lambda (_ entries licenses)
80 (apply #'guix-message-packages-by-license
81 entries 'output licenses)))
82 (location
83 ,(lambda (_ entries locations)
84 (apply #'guix-message-packages-by-location
85 entries 'output locations)))
86 (from-file
87 (0 "No package in file '%s'." val)
88 (1 "Package from file '%s'." val)
89 (many "Package outputs from file '%s'." val))
90 (regexp
91 (0 "No package outputs matching '%s'." val)
92 (1 "A single package output matching '%s'." val)
93 (many "%d package outputs matching '%s'." count val))
94 (all-available
95 (0 "No package outputs are available for some reason.")
96 (1 "A single available package output (that's strange).")
97 (many "%d available package outputs." count))
98 (newest-available
99 (0 "No package outputs are available for some reason.")
100 (1 "A single newest available package output (that's strange).")
101 (many "%d newest available package outputs." count))
102 (installed
103 (0 "No package outputs installed in profile '%s'." profile)
104 (1 "A single package output installed in profile '%s'." profile)
105 (many "%d package outputs installed in profile '%s'." count profile))
106 (obsolete
107 (0 "No obsolete package outputs in profile '%s'." profile)
108 (1 "A single obsolete package output in profile '%s'." profile)
109 (many "%d obsolete package outputs in profile '%s'." count profile))
110 (profile-diff
111 guix-message-outputs-by-diff))
112
113 (generation
114 (id
115 (0 "Generations not found.")
116 (1 "")
117 (many "%d generations." count))
118 (last
119 (0 "No generations in profile '%s'." profile)
120 (1 "The last generation of profile '%s'." profile)
121 (many "%d last generations of profile '%s'." count profile))
122 (all
123 (0 "No generations in profile '%s'." profile)
124 (1 "A single generation available in profile '%s'." profile)
125 (many "%d generations available in profile '%s'." count profile))
126 (time
127 guix-message-generations-by-time))))
128
129(defun guix-message-string-name (name)
130 "Return a quoted name string."
131 (concat "'" name "'"))
132
133(defun guix-message-string-entry-type (entry-type &optional plural)
134 "Return a string denoting an ENTRY-TYPE."
135 (cl-ecase entry-type
136 (package
137 (if plural "packages" "package"))
138 (output
139 (if plural "package outputs" "package output"))
140 (generation
141 (if plural "generations" "generation"))))
142
143(defun guix-message-string-entries (count entry-type)
144 "Return a string denoting the COUNT of ENTRY-TYPE entries."
145 (cl-case count
146 (0 (concat "No "
147 (guix-message-string-entry-type
148 entry-type 'plural)))
149 (1 (concat "A single "
150 (guix-message-string-entry-type
151 entry-type)))
152 (t (format "%d %s"
153 count
154 (guix-message-string-entry-type
155 entry-type 'plural)))))
156
157(defun guix-message-packages-by-id (entries entry-type ids)
158 "Display a message for packages or outputs searched by IDS."
159 (let* ((count (length entries))
160 (str-beg (guix-message-string-entries count entry-type))
161 (str-end (if (> count 1)
162 (concat "with the following IDs: "
163 (mapconcat #'guix-get-string ids ", "))
164 (concat "with ID " (guix-get-string (car ids))))))
165 (if (zerop count)
166 (message "%s %s.
167Most likely, Guix REPL was restarted, so IDs are not actual
168anymore, because they live only during the REPL process.
169Try \"M-x guix-search-by-name\"."
170 str-beg str-end)
171 (message "%s %s." str-beg str-end))))
172
173(defun guix-message-packages-by-name (entries entry-type names)
174 "Display a message for packages or outputs searched by NAMES."
175 (let* ((count (length entries))
176 (str-beg (guix-message-string-entries count entry-type))
177 (str-end (if (cdr names)
178 (concat "matching the following names: "
179 (mapconcat #'guix-message-string-name
180 names ", "))
181 (concat "with name "
182 (guix-message-string-name (car names))))))
183 (message "%s %s." str-beg str-end)))
184
185(defun guix-message-packages-by-license (entries entry-type license)
186 "Display a message for packages or outputs searched by LICENSE."
187 (let* ((count (length entries))
188 (str-beg (guix-message-string-entries count entry-type))
189 (str-end (format "with license '%s'" license)))
190 (message "%s %s." str-beg str-end)))
191
192(defun guix-message-packages-by-location (entries entry-type location)
193 "Display a message for packages or outputs searched by LOCATION."
194 (let* ((count (length entries))
195 (str-beg (guix-message-string-entries count entry-type))
196 (str-end (format "placed in '%s'" location)))
197 (message "%s %s." str-beg str-end)))
198
199(defun guix-message-generations-by-time (profile entries times)
200 "Display a message for generations searched by TIMES."
201 (let* ((count (length entries))
202 (str-beg (guix-message-string-entries count 'generation))
203 (time-beg (guix-get-time-string (car times)))
204 (time-end (guix-get-time-string (cadr times))))
205 (message (concat "%s of profile '%s'\n"
206 "matching time period '%s' - '%s'.")
207 str-beg profile time-beg time-end)))
208
209(defun guix-message-outputs-by-diff (_ entries profiles)
210 "Display a message for outputs searched by PROFILES difference."
211 (let* ((count (length entries))
212 (str-beg (guix-message-string-entries count 'output))
213 (profile1 (car profiles))
214 (profile2 (cadr profiles)))
215 (cl-multiple-value-bind (new old str-action)
216 (if (string-lessp profile2 profile1)
217 (list profile1 profile2 "added to")
218 (list profile2 profile1 "removed from"))
219 (message "%s %s profile '%s' comparing with profile '%s'."
220 str-beg str-action new old))))
221
222(defun guix-result-message (profile entries entry-type
223 search-type search-vals)
224 "Display an appropriate message after displaying ENTRIES."
225 (let* ((type-spec (guix-assq-value guix-messages
226 (if (eq entry-type 'system-generation)
227 'generation
228 entry-type)
229 search-type))
230 (fun-or-count-spec (car type-spec)))
231 (if (functionp fun-or-count-spec)
232 (funcall fun-or-count-spec profile entries search-vals)
233 (let* ((count (length entries))
234 (count-key (if (> count 1) 'many count))
235 (msg-spec (guix-assq-value type-spec count-key))
236 (msg (car msg-spec))
237 (args (cdr msg-spec)))
238 (mapc (lambda (subst)
239 (setq args (cl-substitute (cdr subst) (car subst) args)))
240 `((count . ,count)
241 (val . ,(car search-vals))
242 (profile . ,profile)))
243 (apply #'message msg args)))))
244
245(provide 'guix-messages)
246
247;;; guix-messages.el ends here
diff --git a/emacs/guix-pcomplete.el b/emacs/guix-pcomplete.el
deleted file mode 100644
index 785e54ef6d8..00000000000
--- a/emacs/guix-pcomplete.el
+++ /dev/null
@@ -1,370 +0,0 @@
1;;; guix-pcomplete.el --- Functions for completing guix commands -*- lexical-binding: t -*-
2
3;; Copyright © 2015 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 completions for "guix" command that may be used in
23;; `shell', `eshell' and wherever `pcomplete' works.
24
25;;; Code:
26
27(require 'pcomplete)
28(require 'pcmpl-unix)
29(require 'cl-lib)
30(require 'guix-utils)
31(require 'guix-help-vars)
32
33
34;;; Interacting with guix
35
36(defcustom guix-pcomplete-guix-program (executable-find "guix")
37 "Name of the 'guix' program.
38It is used to find guix commands, options, packages, etc."
39 :type 'file
40 :group 'pcomplete
41 :group 'guix)
42
43(defun guix-pcomplete-run-guix (&rest args)
44 "Run `guix-pcomplete-guix-program' with ARGS.
45Insert the output to the current buffer."
46 (apply #'call-process
47 guix-pcomplete-guix-program nil t nil args))
48
49(defun guix-pcomplete-run-guix-and-search (regexp &optional group
50 &rest args)
51 "Run `guix-pcomplete-guix-program' with ARGS and search for matches.
52Return a list of strings matching REGEXP.
53GROUP specifies a parenthesized expression used in REGEXP."
54 (with-temp-buffer
55 (apply #'guix-pcomplete-run-guix args)
56 (let (result)
57 (guix-while-search regexp
58 (push (match-string-no-properties group) result))
59 (nreverse result))))
60
61(defmacro guix-pcomplete-define-options-finder (name docstring regexp
62 &optional filter)
63 "Define function NAME to receive guix options and commands.
64
65The defined function takes an optional COMMAND argument. This
66function will run 'guix COMMAND --help' (or 'guix --help' if
67COMMAND is nil) using `guix-pcomplete-run-guix-and-search' and
68return its result.
69
70If FILTER is specified, it should be a function. The result is
71passed to this FILTER as argument and the result value of this
72function call is returned."
73 (declare (doc-string 2) (indent 1))
74 `(guix-memoized-defun ,name (&optional command)
75 ,docstring
76 (let* ((args '("--help"))
77 (args (if command (cons command args) args))
78 (res (apply #'guix-pcomplete-run-guix-and-search
79 ,regexp guix-help-parse-regexp-group args)))
80 ,(if filter
81 `(funcall ,filter res)
82 'res))))
83
84(guix-pcomplete-define-options-finder guix-pcomplete-commands
85 "If COMMAND is nil, return a list of available guix commands.
86If COMMAND is non-nil (it should be a string), return available
87subcommands, actions, etc. for this guix COMMAND."
88 guix-help-parse-command-regexp)
89
90(guix-pcomplete-define-options-finder guix-pcomplete-long-options
91 "Return a list of available long options for guix COMMAND."
92 guix-help-parse-long-option-regexp)
93
94(guix-pcomplete-define-options-finder guix-pcomplete-short-options
95 "Return a string with available short options for guix COMMAND."
96 guix-help-parse-short-option-regexp
97 (lambda (list)
98 (guix-concat-strings list "")))
99
100(guix-memoized-defun guix-pcomplete-all-packages ()
101 "Return a list of all available Guix packages."
102 (guix-pcomplete-run-guix-and-search
103 guix-help-parse-package-regexp
104 guix-help-parse-regexp-group
105 "package" "--list-available"))
106
107(guix-memoized-defun guix-pcomplete-installed-packages (&optional profile)
108 "Return a list of Guix packages installed in PROFILE."
109 (let* ((args (and profile
110 (list (concat "--profile=" profile))))
111 (args (append '("package" "--list-installed") args)))
112 (apply #'guix-pcomplete-run-guix-and-search
113 guix-help-parse-package-regexp
114 guix-help-parse-regexp-group
115 args)))
116
117(guix-memoized-defun guix-pcomplete-lint-checkers ()
118 "Return a list of all available lint checkers."
119 (guix-pcomplete-run-guix-and-search
120 guix-help-parse-list-regexp
121 guix-help-parse-regexp-group
122 "lint" "--list-checkers"))
123
124(guix-memoized-defun guix-pcomplete-graph-types ()
125 "Return a list of all available graph types."
126 (guix-pcomplete-run-guix-and-search
127 guix-help-parse-list-regexp
128 guix-help-parse-regexp-group
129 "graph" "--list-types"))
130
131(guix-memoized-defun guix-pcomplete-refresh-updaters ()
132 "Return a list of all available refresh updater types."
133 (guix-pcomplete-run-guix-and-search
134 guix-help-parse-list-regexp
135 guix-help-parse-regexp-group
136 "refresh" "--list-updaters"))
137
138
139;;; Completing
140
141(defvar guix-pcomplete-option-regexp (rx string-start "-")
142 "Regexp to match an option.")
143
144(defvar guix-pcomplete-long-option-regexp (rx string-start "--")
145 "Regexp to match a long option.")
146
147(defvar guix-pcomplete-long-option-with-arg-regexp
148 (rx string-start
149 (group "--" (one-or-more any)) "="
150 (group (zero-or-more any)))
151 "Regexp to match a long option with its argument.
152The first parenthesized group defines the option and the second
153group - the argument.")
154
155(defvar guix-pcomplete-short-option-with-arg-regexp
156 (rx string-start
157 (group "-" (not (any "-")))
158 (group (zero-or-more any)))
159 "Regexp to match a short option with its argument.
160The first parenthesized group defines the option and the second
161group - the argument.")
162
163(defun guix-pcomplete-match-option ()
164 "Return non-nil, if the current argument is an option."
165 (pcomplete-match guix-pcomplete-option-regexp 0))
166
167(defun guix-pcomplete-match-long-option ()
168 "Return non-nil, if the current argument is a long option."
169 (pcomplete-match guix-pcomplete-long-option-regexp 0))
170
171(defun guix-pcomplete-match-long-option-with-arg ()
172 "Return non-nil, if the current argument is a long option with value."
173 (pcomplete-match guix-pcomplete-long-option-with-arg-regexp 0))
174
175(defun guix-pcomplete-match-short-option-with-arg ()
176 "Return non-nil, if the current argument is a short option with value."
177 (pcomplete-match guix-pcomplete-short-option-with-arg-regexp 0))
178
179(defun guix-pcomplete-long-option-arg (option args)
180 "Return a long OPTION's argument from a list of arguments ARGS."
181 (let* ((re (concat "\\`" option "=\\(.*\\)"))
182 (args (cl-member-if (lambda (arg)
183 (string-match re arg))
184 args))
185 (cur (car args)))
186 (when cur
187 (match-string-no-properties 1 cur))))
188
189(defun guix-pcomplete-short-option-arg (option args)
190 "Return a short OPTION's argument from a list of arguments ARGS."
191 (let* ((re (concat "\\`" option "\\(.*\\)"))
192 (args (cl-member-if (lambda (arg)
193 (string-match re arg))
194 args))
195 (cur (car args)))
196 (when cur
197 (let ((arg (match-string-no-properties 1 cur)))
198 (if (string= "" arg)
199 (cadr args) ; take the next arg
200 arg)))))
201
202(defun guix-pcomplete-complete-comma-args (entries)
203 "Complete comma separated arguments using ENTRIES."
204 (let ((index pcomplete-index))
205 (while (= index pcomplete-index)
206 (let* ((args (if (or (guix-pcomplete-match-long-option-with-arg)
207 (guix-pcomplete-match-short-option-with-arg))
208 (pcomplete-match-string 2 0)
209 (pcomplete-arg 0)))
210 (input (if (string-match ".*,\\(.*\\)" args)
211 (match-string-no-properties 1 args)
212 args)))
213 (pcomplete-here* entries input)))))
214
215(defun guix-pcomplete-complete-command-arg (command)
216 "Complete argument for guix COMMAND."
217 (cond
218 ((member command
219 '("archive" "build" "challenge" "edit" "environment"
220 "graph" "lint" "refresh" "size"))
221 (while t
222 (pcomplete-here (guix-pcomplete-all-packages))))
223 (t (pcomplete-here* (pcomplete-entries)))))
224
225(defun guix-pcomplete-complete-option-arg (command option &optional input)
226 "Complete argument for COMMAND's OPTION.
227INPUT is the current partially completed string."
228 (cl-flet ((option? (short long)
229 (or (string= option short)
230 (string= option long)))
231 (command? (&rest commands)
232 (member command commands))
233 (complete (entries)
234 (pcomplete-here entries input nil t))
235 (complete* (entries)
236 (pcomplete-here* entries input t)))
237 (cond
238 ((option? "-L" "--load-path")
239 (complete* (pcomplete-dirs)))
240 ((string= "--key-download" option)
241 (complete* guix-help-key-policies))
242
243 ((command? "package")
244 (cond
245 ;; For '--install[=]' and '--remove[=]', try to complete a package
246 ;; name (INPUT) after the "=" sign, and then the rest packages
247 ;; separated with spaces.
248 ((option? "-i" "--install")
249 (complete (guix-pcomplete-all-packages))
250 (while (not (guix-pcomplete-match-option))
251 (pcomplete-here (guix-pcomplete-all-packages))))
252 ((option? "-r" "--remove")
253 (let* ((profile (or (guix-pcomplete-short-option-arg
254 "-p" pcomplete-args)
255 (guix-pcomplete-long-option-arg
256 "--profile" pcomplete-args)))
257 (profile (and profile (expand-file-name profile))))
258 (complete (guix-pcomplete-installed-packages profile))
259 (while (not (guix-pcomplete-match-option))
260 (pcomplete-here (guix-pcomplete-installed-packages profile)))))
261 ((string= "--show" option)
262 (complete (guix-pcomplete-all-packages)))
263 ((option? "-p" "--profile")
264 (complete* (pcomplete-dirs)))
265 ((or (option? "-f" "--install-from-file")
266 (option? "-m" "--manifest"))
267 (complete* (pcomplete-entries)))))
268
269 ((and (command? "archive" "build" "size")
270 (option? "-s" "--system"))
271 (complete* guix-help-system-types))
272
273 ((and (command? "build")
274 (or (option? "-f" "--file")
275 (option? "-r" "--root")
276 (string= "--with-source" option)))
277 (complete* (pcomplete-entries)))
278
279 ((and (command? "graph")
280 (option? "-t" "--type"))
281 (complete* (guix-pcomplete-graph-types)))
282
283 ((and (command? "environment")
284 (option? "-l" "--load"))
285 (complete* (pcomplete-entries)))
286
287 ((and (command? "hash" "download")
288 (option? "-f" "--format"))
289 (complete* guix-help-hash-formats))
290
291 ((and (command? "lint")
292 (option? "-c" "--checkers"))
293 (guix-pcomplete-complete-comma-args
294 (guix-pcomplete-lint-checkers)))
295
296 ((and (command? "publish")
297 (option? "-u" "--user"))
298 (complete* (pcmpl-unix-user-names)))
299
300 ((command? "refresh")
301 (cond
302 ((option? "-s" "--select")
303 (complete* guix-help-refresh-subsets))
304 ((option? "-t" "--type")
305 (guix-pcomplete-complete-comma-args
306 (guix-pcomplete-refresh-updaters)))))
307
308 ((and (command? "size")
309 (option? "-m" "--map-file"))
310 (complete* (pcomplete-entries))))))
311
312(defun guix-pcomplete-complete-options (command)
313 "Complete options (with their arguments) for guix COMMAND."
314 (while (guix-pcomplete-match-option)
315 (let ((index pcomplete-index))
316 (if (guix-pcomplete-match-long-option)
317
318 ;; Long options.
319 (if (guix-pcomplete-match-long-option-with-arg)
320 (let ((option (pcomplete-match-string 1 0))
321 (arg (pcomplete-match-string 2 0)))
322 (guix-pcomplete-complete-option-arg
323 command option arg))
324
325 (pcomplete-here* (guix-pcomplete-long-options command))
326 ;; We support '--opt arg' style (along with '--opt=arg'),
327 ;; because 'guix package --install/--remove' may be used this
328 ;; way. So try to complete an argument after the option has
329 ;; been completed.
330 (unless (guix-pcomplete-match-option)
331 (guix-pcomplete-complete-option-arg
332 command (pcomplete-arg 0 -1))))
333
334 ;; Short options.
335 (let ((arg (pcomplete-arg 0)))
336 (if (> (length arg) 2)
337 ;; Support specifying an argument after a short option without
338 ;; spaces (for example, '-L/tmp/foo').
339 (guix-pcomplete-complete-option-arg
340 command
341 (substring-no-properties arg 0 2)
342 (substring-no-properties arg 2))
343 (pcomplete-opt (guix-pcomplete-short-options command))
344 (guix-pcomplete-complete-option-arg
345 command (pcomplete-arg 0 -1)))))
346
347 ;; If there were no completions, move to the next argument and get
348 ;; out if the last argument is achieved.
349 (when (= index pcomplete-index)
350 (if (= pcomplete-index pcomplete-last)
351 (throw 'pcompleted nil)
352 (pcomplete-next-arg))))))
353
354;;;###autoload
355(defun pcomplete/guix ()
356 "Completion for `guix'."
357 (let ((commands (guix-pcomplete-commands)))
358 (pcomplete-here* (cons "--help" commands))
359 (let ((command (pcomplete-arg 'first 1)))
360 (when (member command commands)
361 (guix-pcomplete-complete-options command)
362 (let ((subcommands (guix-pcomplete-commands command)))
363 (when subcommands
364 (pcomplete-here* subcommands)))
365 (guix-pcomplete-complete-options command)
366 (guix-pcomplete-complete-command-arg command)))))
367
368(provide 'guix-pcomplete)
369
370;;; guix-pcomplete.el ends here
diff --git a/emacs/guix-popup.el b/emacs/guix-popup.el
deleted file mode 100644
index 59e98a352e7..00000000000
--- a/emacs/guix-popup.el
+++ /dev/null
@@ -1,48 +0,0 @@
1;;; guix-popup.el --- Popup windows library
2
3;; Copyright © 2015 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 `guix-define-popup' macro which is just an alias
23;; to `magit-define-popup'. According to the manual (info
24;; "(magit-popup) Defining prefix and suffix commands") `magit-popup'
25;; library will eventually be superseded by a more general library.
26
27;;; Code:
28
29(require 'magit-popup)
30
31(defalias 'guix-define-popup 'magit-define-popup)
32
33(defvar guix-popup-font-lock-keywords
34 (eval-when-compile
35 `((,(rx "("
36 (group "guix-define-popup")
37 symbol-end
38 (zero-or-more blank)
39 (zero-or-one
40 (group (one-or-more (or (syntax word) (syntax symbol))))))
41 (1 font-lock-keyword-face)
42 (2 font-lock-function-name-face nil t)))))
43
44(font-lock-add-keywords 'emacs-lisp-mode guix-popup-font-lock-keywords)
45
46(provide 'guix-popup)
47
48;;; guix-popup.el ends here
diff --git a/emacs/guix-prettify.el b/emacs/guix-prettify.el
deleted file mode 100644
index 38d72e860bd..00000000000
--- a/emacs/guix-prettify.el
+++ /dev/null
@@ -1,210 +0,0 @@
1;;; guix-prettify.el --- Prettify Guix store file names
2
3;; Copyright © 2014, 2015 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 package provides minor-mode for prettifying Guix store file
23;; names — i.e., after enabling `guix-prettify-mode',
24;; '/gnu/store/72f54nfp6g1hz873w8z3gfcah0h4nl9p-foo-0.1' names will be
25;; replaced with '/gnu/store/…-foo-0.1' in the current buffer. There is
26;; also `global-guix-prettify-mode' for global prettifying.
27
28;; To install, add the following to your emacs init file:
29;;
30;; (add-to-list 'load-path "/path/to/dir-with-guix-prettify")
31;; (autoload 'guix-prettify-mode "guix-prettify" nil t)
32;; (autoload 'global-guix-prettify-mode "guix-prettify" nil t)
33
34;; If you want to enable/disable composition after "M-x font-lock-mode",
35;; use the following setting:
36;;
37;; (setq font-lock-extra-managed-props
38;; (cons 'composition font-lock-extra-managed-props))
39
40;; Credits:
41;;
42;; Thanks to Ludovic Courtès for the idea of this package.
43;;
44;; Thanks to the authors of `prettify-symbols-mode' (part of Emacs 24.4)
45;; and "pretty-symbols.el" <http://github.com/drothlis/pretty-symbols>
46;; for the code. It helped to write this package.
47
48;;; Code:
49
50(require 'guix-utils)
51
52(defgroup guix-prettify nil
53 "Prettify Guix store file names."
54 :prefix "guix-prettify-"
55 :group 'guix
56 :group 'font-lock
57 :group 'convenience)
58
59(defcustom guix-prettify-char ?…
60 "Character used for prettifying."
61 :type 'character
62 :group 'guix-prettify)
63
64(defcustom guix-prettify-decompose-force nil
65 "If non-nil, remove any composition.
66
67By default, after disabling `guix-prettify-mode',
68compositions (prettifying names with `guix-prettify-char') are
69removed only from strings matching `guix-prettify-regexp', so
70that compositions created by other modes are left untouched.
71
72Set this variable to non-nil, if you want to remove any
73composition unconditionally (like `prettify-symbols-mode' does).
74Most likely it will do no harm and will make the process of
75disabling `guix-prettify-mode' a little faster."
76 :type 'boolean
77 :group 'guix-prettify)
78
79(defcustom guix-prettify-regexp
80 ;; The following file names / URLs should be abbreviated:
81
82 ;; /gnu/store/…-foo-0.1
83 ;; /nix/store/…-foo-0.1
84 ;; http://hydra.gnu.org/nar/…-foo-0.1
85 ;; http://hydra.gnu.org/log/…-foo-0.1
86
87 (rx "/" (or "store" "nar" "log") "/"
88 ;; Hash-parts do not include "e", "o", "u" and "t". See base32Chars
89 ;; at <https://github.com/NixOS/nix/blob/master/src/libutil/hash.cc>
90 (group (= 32 (any "0-9" "a-d" "f-n" "p-s" "v-z"))))
91 "Regexp matching file names for prettifying.
92
93Disable `guix-prettify-mode' before modifying this variable and
94make sure to modify `guix-prettify-regexp-group' if needed.
95
96Example of a \"deeper\" prettifying:
97
98 (setq guix-prettify-regexp \"store/[[:alnum:]]\\\\\\={32\\\\}\"
99 guix-prettify-regexp-group 0)
100
101This will transform
102'/gnu/store/72f54nfp6g1hz873w8z3gfcah0h4nl9p-foo-0.1' into
103'/gnu/…-foo-0.1'"
104 :type 'regexp
105 :group 'guix-prettify)
106
107(defcustom guix-prettify-regexp-group 1
108 "Regexp group in `guix-prettify-regexp' for prettifying."
109 :type 'integer
110 :group 'guix-prettify)
111
112(defvar guix-prettify-special-modes
113 '(guix-info-mode ibuffer-mode)
114 "List of special modes that support font-locking.
115
116By default, \\[global-guix-prettify-mode] enables prettifying in
117all buffers except the ones where `font-lock-defaults' is
118nil (see Info node `(elisp) Font Lock Basics'), because it may
119break the existing highlighting.
120
121Modes from this list and all derived modes are exceptions
122\(`global-guix-prettify-mode' enables prettifying there).")
123
124(defvar guix-prettify-flush-function
125 (cond ((fboundp 'font-lock-flush) #'font-lock-flush)
126 ((fboundp 'jit-lock-refontify) #'jit-lock-refontify))
127 "Function used to refontify buffer.
128This function is called without arguments after
129enabling/disabling `guix-prettify-mode'. If nil, do nothing.")
130
131(defun guix-prettify-compose ()
132 "Compose matching region in the current buffer."
133 (let ((beg (match-beginning guix-prettify-regexp-group))
134 (end (match-end guix-prettify-regexp-group)))
135 (compose-region beg end guix-prettify-char 'decompose-region))
136 ;; Return nil because we're not adding any face property.
137 nil)
138
139(defun guix-prettify-decompose-buffer ()
140 "Remove file names compositions from the current buffer."
141 (with-silent-modifications
142 (let ((inhibit-read-only t))
143 (if guix-prettify-decompose-force
144 (remove-text-properties (point-min)
145 (point-max)
146 '(composition nil))
147 (guix-while-search guix-prettify-regexp
148 (remove-text-properties
149 (match-beginning guix-prettify-regexp-group)
150 (match-end guix-prettify-regexp-group)
151 '(composition nil)))))))
152
153;;;###autoload
154(define-minor-mode guix-prettify-mode
155 "Toggle Guix Prettify mode.
156
157With a prefix argument ARG, enable Guix Prettify mode if ARG is
158positive, and disable it otherwise. If called from Lisp, enable
159the mode if ARG is omitted or nil.
160
161When Guix Prettify mode is enabled, hash-parts of the Guix store
162file names (see `guix-prettify-regexp') are prettified,
163i.e. displayed as `guix-prettify-char' character. This mode can
164be enabled programmatically using hooks:
165
166 (add-hook 'shell-mode-hook 'guix-prettify-mode)
167
168It is possible to enable the mode in any buffer, however not any
169buffer's highlighting may survive after adding new elements to
170`font-lock-keywords' (see `guix-prettify-special-modes' for
171details).
172
173Also you can use `global-guix-prettify-mode' to enable Guix
174Prettify mode for all modes that support font-locking."
175 :init-value nil
176 :lighter " …"
177 (let ((keywords `((,guix-prettify-regexp
178 (,guix-prettify-regexp-group
179 (guix-prettify-compose))))))
180 (if guix-prettify-mode
181 ;; Turn on.
182 (font-lock-add-keywords nil keywords)
183 ;; Turn off.
184 (font-lock-remove-keywords nil keywords)
185 (guix-prettify-decompose-buffer))
186 (and guix-prettify-flush-function
187 (funcall guix-prettify-flush-function))))
188
189(defun guix-prettify-supported-p ()
190 "Return non-nil, if the mode can be harmlessly enabled in current buffer."
191 (or font-lock-defaults
192 (apply #'derived-mode-p guix-prettify-special-modes)))
193
194(defun guix-prettify-turn-on ()
195 "Enable `guix-prettify-mode' in the current buffer if needed.
196See `guix-prettify-special-modes' for details."
197 (and (not guix-prettify-mode)
198 (guix-prettify-supported-p)
199 (guix-prettify-mode)))
200
201;;;###autoload
202(define-globalized-minor-mode global-guix-prettify-mode
203 guix-prettify-mode guix-prettify-turn-on)
204
205;;;###autoload
206(defalias 'guix-prettify-global-mode 'global-guix-prettify-mode)
207
208(provide 'guix-prettify)
209
210;;; guix-prettify.el ends here
diff --git a/emacs/guix-profiles.el b/emacs/guix-profiles.el
deleted file mode 100644
index 12cf46dbf82..00000000000
--- a/emacs/guix-profiles.el
+++ /dev/null
@@ -1,77 +0,0 @@
1;;; guix-profiles.el --- Guix profiles
2
3;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com>
4;; Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org>
5
6;; This file is part of GNU Guix.
7
8;; GNU Guix is free software; you can redistribute it and/or modify
9;; it under the terms of the GNU General Public License as published by
10;; the Free Software Foundation, either version 3 of the License, or
11;; (at your option) any later version.
12
13;; GNU Guix is distributed in the hope that it will be useful,
14;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16;; GNU General Public License for more details.
17
18;; You should have received a copy of the GNU General Public License
19;; along with this program. If not, see <http://www.gnu.org/licenses/>.
20
21;;; Code:
22
23(require 'guix-config)
24
25(defvar guix-user-profile
26 (expand-file-name "~/.guix-profile")
27 "User profile.")
28
29(defvar guix-system-profile
30 (concat guix-config-state-directory "/profiles/system")
31 "System profile.")
32
33(defvar guix-default-profile
34 (concat guix-config-state-directory
35 "/profiles/per-user/"
36 (getenv "USER")
37 "/guix-profile")
38 "Default Guix profile.")
39
40(defvar guix-current-profile guix-default-profile
41 "Current profile.")
42
43(defvar guix-system-profile-regexp
44 (concat "\\`" (regexp-quote guix-system-profile))
45 "Regexp matching system profiles.")
46
47(defun guix-system-profile? (profile)
48 "Return non-nil, if PROFILE is a system one."
49 (string-match-p guix-system-profile-regexp profile))
50
51(defun guix-profile-prompt (&optional default)
52 "Prompt for profile and return it.
53Use DEFAULT as a start directory. If it is nil, use
54`guix-current-profile'."
55 (let* ((path (read-file-name "Profile: "
56 (file-name-directory
57 (or default guix-current-profile))))
58 (path (directory-file-name (expand-file-name path))))
59 (if (string= path guix-user-profile)
60 guix-default-profile
61 path)))
62
63(defun guix-set-current-profile (path)
64 "Set `guix-current-profile' to PATH.
65Interactively, prompt for PATH. With prefix, use
66`guix-default-profile'."
67 (interactive
68 (list (if current-prefix-arg
69 guix-default-profile
70 (guix-profile-prompt))))
71 (setq guix-current-profile path)
72 (message "Current profile has been set to '%s'."
73 guix-current-profile))
74
75(provide 'guix-profiles)
76
77;;; guix-profiles.el ends here
diff --git a/emacs/guix-read.el b/emacs/guix-read.el
deleted file mode 100644
index 5423c9bcfa3..00000000000
--- a/emacs/guix-read.el
+++ /dev/null
@@ -1,147 +0,0 @@
1;;; guix-read.el --- Minibuffer readers
2
3;; Copyright © 2015, 2016 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 functions to prompt a user for packages, system
23;; types, hash formats and other guix related stuff.
24
25;;; Code:
26
27(require 'guix-help-vars)
28(require 'guix-utils)
29(require 'guix-backend)
30(require 'guix-guile)
31
32
33;;; Receivable lists of packages, lint checkers, etc.
34
35(guix-memoized-defun guix-graph-type-names ()
36 "Return a list of names of available graph node types."
37 (guix-eval-read (guix-make-guile-expression 'graph-type-names)))
38
39(guix-memoized-defun guix-refresh-updater-names ()
40 "Return a list of names of available refresh updater types."
41 (guix-eval-read (guix-make-guile-expression 'refresh-updater-names)))
42
43(guix-memoized-defun guix-lint-checker-names ()
44 "Return a list of names of available lint checkers."
45 (guix-eval-read (guix-make-guile-expression 'lint-checker-names)))
46
47(guix-memoized-defun guix-package-names ()
48 "Return a list of names of available packages."
49 (sort
50 ;; Work around <https://github.com/jaor/geiser/issues/64>:
51 ;; list of strings is parsed much slower than list of lists,
52 ;; so we use 'package-names-lists' instead of 'package-names'.
53
54 ;; (guix-eval-read (guix-make-guile-expression 'package-names))
55
56 (mapcar #'car
57 (guix-eval-read (guix-make-guile-expression
58 'package-names-lists)))
59 #'string<))
60
61(guix-memoized-defun guix-license-names ()
62 "Return a list of names of available licenses."
63 (guix-eval-read (guix-make-guile-expression 'license-names)))
64
65(guix-memoized-defun guix-package-locations ()
66 "Return a list of available package locations."
67 (sort (guix-eval-read (guix-make-guile-expression
68 'package-location-files))
69 #'string<))
70
71
72;;; Readers
73
74(guix-define-readers
75 :completions-var guix-help-system-types
76 :single-reader guix-read-system-type
77 :single-prompt "System type: ")
78
79(guix-define-readers
80 :completions-var guix-help-source-types
81 :single-reader guix-read-source-type
82 :single-prompt "Source type: ")
83
84(guix-define-readers
85 :completions-var guix-help-hash-formats
86 :single-reader guix-read-hash-format
87 :single-prompt "Hash format: ")
88
89(guix-define-readers
90 :completions-var guix-help-refresh-subsets
91 :single-reader guix-read-refresh-subset
92 :single-prompt "Refresh subset: ")
93
94(guix-define-readers
95 :completions-getter guix-refresh-updater-names
96 :multiple-reader guix-read-refresh-updater-names
97 :multiple-prompt "Refresh updater,s: "
98 :multiple-separator ",")
99
100(guix-define-readers
101 :completions-var guix-help-key-policies
102 :single-reader guix-read-key-policy
103 :single-prompt "Key policy: ")
104
105(guix-define-readers
106 :completions-var guix-help-elpa-archives
107 :single-reader guix-read-elpa-archive
108 :single-prompt "ELPA archive: ")
109
110(guix-define-readers
111 :completions-var guix-help-verify-options
112 :multiple-reader guix-read-verify-options
113 :multiple-prompt "Verify option,s: "
114 :multiple-separator ",")
115
116(guix-define-readers
117 :completions-getter guix-graph-type-names
118 :single-reader guix-read-graph-type
119 :single-prompt "Graph node type: ")
120
121(guix-define-readers
122 :completions-getter guix-lint-checker-names
123 :multiple-reader guix-read-lint-checker-names
124 :multiple-prompt "Linter,s: "
125 :multiple-separator ",")
126
127(guix-define-readers
128 :completions-getter guix-package-names
129 :single-reader guix-read-package-name
130 :single-prompt "Package: "
131 :multiple-reader guix-read-package-names
132 :multiple-prompt "Package,s: "
133 :multiple-separator " ")
134
135(guix-define-readers
136 :completions-getter guix-license-names
137 :single-reader guix-read-license-name
138 :single-prompt "License: ")
139
140(guix-define-readers
141 :completions-getter guix-package-locations
142 :single-reader guix-read-package-location
143 :single-prompt "Location: ")
144
145(provide 'guix-read)
146
147;;; guix-read.el ends here
diff --git a/emacs/guix-ui-generation.el b/emacs/guix-ui-generation.el
deleted file mode 100644
index 67cf6294fb5..00000000000
--- a/emacs/guix-ui-generation.el
+++ /dev/null
@@ -1,456 +0,0 @@
1;;; guix-ui-generation.el --- Interface for displaying generations -*- lexical-binding: t -*-
2
3;; Copyright © 2014, 2015, 2016 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 an interface for displaying profile generations in
23;; 'list' and 'info' buffers, and commands for working with them.
24
25;;; Code:
26
27(require 'cl-lib)
28(require 'guix-buffer)
29(require 'guix-list)
30(require 'guix-info)
31(require 'guix-ui)
32(require 'guix-ui-package)
33(require 'guix-base)
34(require 'guix-backend)
35(require 'guix-guile)
36(require 'guix-entry)
37(require 'guix-utils)
38(require 'guix-profiles)
39
40(guix-ui-define-entry-type generation)
41
42(defun guix-generation-get-display (profile search-type &rest search-values)
43 "Search for generations and show results.
44
45If PROFILE is nil, use `guix-current-profile'.
46
47See `guix-ui-get-entries' for the meaning of SEARCH-TYPE and
48SEARCH-VALUES."
49 (apply #'guix-list-get-display-entries
50 'generation
51 (or profile guix-current-profile)
52 search-type search-values))
53
54(defun guix-delete-generations (profile generations
55 &optional operation-buffer)
56 "Delete GENERATIONS from PROFILE.
57Each element from GENERATIONS is a generation number."
58 (when (or (not guix-operation-confirm)
59 (y-or-n-p
60 (let ((count (length generations)))
61 (if (> count 1)
62 (format "Delete %d generations from profile '%s'? "
63 count profile)
64 (format "Delete generation %d from profile '%s'? "
65 (car generations) profile)))))
66 (guix-eval-in-repl
67 (guix-make-guile-expression
68 'delete-generations* profile generations)
69 operation-buffer)))
70
71(defun guix-switch-to-generation (profile generation
72 &optional operation-buffer)
73 "Switch PROFILE to GENERATION."
74 (when (or (not guix-operation-confirm)
75 (y-or-n-p (format "Switch profile '%s' to generation %d? "
76 profile generation)))
77 (guix-eval-in-repl
78 (guix-make-guile-expression
79 'switch-to-generation* profile generation)
80 operation-buffer)))
81
82(defun guix-system-generation? ()
83 "Return non-nil, if current generation is a system one."
84 (eq (guix-buffer-current-entry-type)
85 'system-generation))
86
87(defun guix-generation-current-packages-profile (&optional generation)
88 "Return a directory where packages are installed for the
89current profile's GENERATION."
90 (guix-packages-profile (guix-ui-current-profile)
91 generation
92 (guix-system-generation?)))
93
94
95;;; Generation 'info'
96
97(guix-ui-info-define-interface generation
98 :buffer-name "*Guix Generation Info*"
99 :format '((number format guix-generation-info-insert-number)
100 (prev-number format (format))
101 (current format guix-generation-info-insert-current)
102 (path simple (indent guix-file))
103 (time format (time)))
104 :titles '((path . "File name")
105 (prev-number . "Previous number")))
106
107(defface guix-generation-info-number
108 '((t :inherit font-lock-keyword-face))
109 "Face used for a number of a generation."
110 :group 'guix-generation-info-faces)
111
112(defface guix-generation-info-current
113 '((t :inherit guix-package-info-installed-outputs))
114 "Face used if a generation is the current one."
115 :group 'guix-generation-info-faces)
116
117(defface guix-generation-info-not-current
118 '((t nil))
119 "Face used if a generation is not the current one."
120 :group 'guix-generation-info-faces)
121
122(defun guix-generation-info-insert-number (number &optional _)
123 "Insert generation NUMBER and action buttons."
124 (guix-info-insert-value-format number 'guix-generation-info-number)
125 (guix-info-insert-indent)
126 (guix-info-insert-action-button
127 "Packages"
128 (lambda (btn)
129 (guix-buffer-get-display-entries
130 'list guix-package-list-type
131 (list (guix-generation-current-packages-profile
132 (button-get btn 'number))
133 'installed)
134 'add))
135 "Show installed packages for this generation"
136 'number number)
137 (guix-info-insert-indent)
138 (guix-info-insert-action-button
139 "Delete"
140 (lambda (btn)
141 (guix-delete-generations (guix-ui-current-profile)
142 (list (button-get btn 'number))
143 (current-buffer)))
144 "Delete this generation"
145 'number number))
146
147(defun guix-generation-info-insert-current (val entry)
148 "Insert boolean value VAL showing whether this generation is current."
149 (if val
150 (guix-info-insert-value-format "Yes" 'guix-generation-info-current)
151 (guix-info-insert-value-format "No" 'guix-generation-info-not-current)
152 (guix-info-insert-indent)
153 (guix-info-insert-action-button
154 "Switch"
155 (lambda (btn)
156 (guix-switch-to-generation (guix-ui-current-profile)
157 (button-get btn 'number)
158 (current-buffer)))
159 "Switch to this generation (make it the current one)"
160 'number (guix-entry-value entry 'number))))
161
162
163;;; Generation 'list'
164
165(guix-ui-list-define-interface generation
166 :buffer-name "*Guix Generation List*"
167 :format '((number nil 5 guix-list-sort-numerically-0 :right-align t)
168 (current guix-generation-list-get-current 10 t)
169 (time guix-list-get-time 20 t)
170 (path guix-list-get-file-name 30 t))
171 :titles '((number . "N."))
172 :sort-key '(number . t)
173 :marks '((delete . ?D)))
174
175(let ((map guix-generation-list-mode-map))
176 (define-key map (kbd "RET") 'guix-generation-list-show-packages)
177 (define-key map (kbd "+") 'guix-generation-list-show-added-packages)
178 (define-key map (kbd "-") 'guix-generation-list-show-removed-packages)
179 (define-key map (kbd "=") 'guix-generation-list-diff)
180 (define-key map (kbd "D") 'guix-generation-list-diff)
181 (define-key map (kbd "e") 'guix-generation-list-ediff)
182 (define-key map (kbd "x") 'guix-generation-list-execute)
183 (define-key map (kbd "s") 'guix-generation-list-switch)
184 (define-key map (kbd "c") 'guix-generation-list-switch)
185 (define-key map (kbd "d") 'guix-generation-list-mark-delete))
186
187(defun guix-generation-list-get-current (val &optional _)
188 "Return string from VAL showing whether this generation is current.
189VAL is a boolean value."
190 (if val "(current)" ""))
191
192(defun guix-generation-list-switch ()
193 "Switch current profile to the generation at point."
194 (interactive)
195 (let* ((entry (guix-list-current-entry))
196 (current (guix-entry-value entry 'current))
197 (number (guix-entry-value entry 'number)))
198 (if current
199 (user-error "This generation is already the current one")
200 (guix-switch-to-generation (guix-ui-current-profile)
201 number (current-buffer)))))
202
203(defun guix-generation-list-show-packages ()
204 "List installed packages for the generation at point."
205 (interactive)
206 (guix-package-get-display
207 (guix-generation-current-packages-profile (guix-list-current-id))
208 'installed))
209
210(defun guix-generation-list-generations-to-compare ()
211 "Return a sorted list of 2 marked generations for comparing."
212 (let ((numbers (guix-list-get-marked-id-list 'general)))
213 (if (/= (length numbers) 2)
214 (user-error "2 generations should be marked for comparing")
215 (sort numbers #'<))))
216
217(defun guix-generation-list-profiles-to-compare ()
218 "Return a sorted list of 2 marked generation profiles for comparing."
219 (mapcar #'guix-generation-current-packages-profile
220 (guix-generation-list-generations-to-compare)))
221
222(defun guix-generation-list-show-added-packages ()
223 "List package outputs added to the latest marked generation.
224If 2 generations are marked with \\[guix-list-mark], display
225outputs installed in the latest marked generation that were not
226installed in the other one."
227 (interactive)
228 (guix-buffer-get-display-entries
229 'list 'output
230 (cl-list* (guix-ui-current-profile)
231 'profile-diff
232 (reverse (guix-generation-list-profiles-to-compare)))
233 'add))
234
235(defun guix-generation-list-show-removed-packages ()
236 "List package outputs removed from the latest marked generation.
237If 2 generations are marked with \\[guix-list-mark], display
238outputs not installed in the latest marked generation that were
239installed in the other one."
240 (interactive)
241 (guix-buffer-get-display-entries
242 'list 'output
243 (cl-list* (guix-ui-current-profile)
244 'profile-diff
245 (guix-generation-list-profiles-to-compare))
246 'add))
247
248(defun guix-generation-list-compare (diff-fun gen-fun)
249 "Run GEN-FUN on the 2 marked generations and run DIFF-FUN on the results."
250 (cl-multiple-value-bind (gen1 gen2)
251 (guix-generation-list-generations-to-compare)
252 (funcall diff-fun
253 (funcall gen-fun gen1)
254 (funcall gen-fun gen2))))
255
256(defun guix-generation-list-ediff-manifests ()
257 "Run Ediff on manifests of the 2 marked generations."
258 (interactive)
259 (guix-generation-list-compare
260 #'ediff-files
261 #'guix-profile-generation-manifest-file))
262
263(defun guix-generation-list-diff-manifests ()
264 "Run Diff on manifests of the 2 marked generations."
265 (interactive)
266 (guix-generation-list-compare
267 #'guix-diff
268 #'guix-profile-generation-manifest-file))
269
270(defun guix-generation-list-ediff-packages ()
271 "Run Ediff on package outputs installed in the 2 marked generations."
272 (interactive)
273 (guix-generation-list-compare
274 #'ediff-buffers
275 #'guix-profile-generation-packages-buffer))
276
277(defun guix-generation-list-diff-packages ()
278 "Run Diff on package outputs installed in the 2 marked generations."
279 (interactive)
280 (guix-generation-list-compare
281 #'guix-diff
282 #'guix-profile-generation-packages-buffer))
283
284(defun guix-generation-list-ediff (arg)
285 "Run Ediff on package outputs installed in the 2 marked generations.
286With ARG, run Ediff on manifests of the marked generations."
287 (interactive "P")
288 (if arg
289 (guix-generation-list-ediff-manifests)
290 (guix-generation-list-ediff-packages)))
291
292(defun guix-generation-list-diff (arg)
293 "Run Diff on package outputs installed in the 2 marked generations.
294With ARG, run Diff on manifests of the marked generations."
295 (interactive "P")
296 (if arg
297 (guix-generation-list-diff-manifests)
298 (guix-generation-list-diff-packages)))
299
300(defun guix-generation-list-mark-delete (&optional arg)
301 "Mark the current generation for deletion and move to the next line.
302With ARG, mark all generations for deletion."
303 (interactive "P")
304 (if arg
305 (guix-list-mark-all 'delete)
306 (guix-list--mark 'delete t)))
307
308(defun guix-generation-list-execute ()
309 "Delete marked generations."
310 (interactive)
311 (let ((marked (guix-list-get-marked-id-list 'delete)))
312 (or marked
313 (user-error "No generations marked for deletion"))
314 (guix-delete-generations (guix-ui-current-profile)
315 marked (current-buffer))))
316
317
318;;; Inserting packages to compare generations
319
320(defcustom guix-generation-packages-buffer-name-function
321 #'guix-generation-packages-buffer-name-default
322 "Function used to define name of a buffer with generation packages.
323This function is called with 2 arguments: PROFILE (string) and
324GENERATION (number)."
325 :type '(choice (function-item guix-generation-packages-buffer-name-default)
326 (function-item guix-generation-packages-buffer-name-long)
327 (function :tag "Other function"))
328 :group 'guix-generation)
329
330(defcustom guix-generation-packages-update-buffer t
331 "If non-nil, always update list of packages during comparing generations.
332If nil, generation packages are received only once. So when you
333compare generation 1 and generation 2, the packages for both
334generations will be received. Then if you compare generation 1
335and generation 3, only the packages for generation 3 will be
336received. Thus if you use comparing of different generations a
337lot, you may set this variable to nil to improve the
338performance."
339 :type 'boolean
340 :group 'guix-generation)
341
342(defvar guix-generation-output-name-width 30
343 "Width of an output name \"column\".
344This variable is used in auxiliary buffers for comparing generations.")
345
346(defun guix-generation-packages (profile)
347 "Return a list of sorted packages installed in PROFILE.
348Each element of the list is a list of the package specification
349and its store path."
350 (let ((names+paths (guix-eval-read
351 (guix-make-guile-expression
352 'profile->specifications+paths profile))))
353 (sort names+paths
354 (lambda (a b)
355 (string< (car a) (car b))))))
356
357(defun guix-generation-packages-buffer-name-default (profile generation)
358 "Return name of a buffer for displaying GENERATION's package outputs.
359Use base name of PROFILE file name."
360 (let ((profile-name (file-name-base (directory-file-name profile))))
361 (format "*Guix %s: generation %s*"
362 profile-name generation)))
363
364(defun guix-generation-packages-buffer-name-long (profile generation)
365 "Return name of a buffer for displaying GENERATION's package outputs.
366Use the full PROFILE file name."
367 (format "*Guix generation %s (%s)*"
368 generation profile))
369
370(defun guix-generation-packages-buffer-name (profile generation)
371 "Return name of a buffer for displaying GENERATION's package outputs."
372 (funcall guix-generation-packages-buffer-name-function
373 profile generation))
374
375(defun guix-generation-insert-package (name path)
376 "Insert package output NAME and store PATH at point."
377 (insert name)
378 (indent-to guix-generation-output-name-width 2)
379 (insert path "\n"))
380
381(defun guix-generation-insert-packages (buffer profile)
382 "Insert package outputs installed in PROFILE in BUFFER."
383 (with-current-buffer buffer
384 (setq buffer-read-only nil
385 indent-tabs-mode nil)
386 (erase-buffer)
387 (mapc (lambda (name+path)
388 (guix-generation-insert-package
389 (car name+path) (cadr name+path)))
390 (guix-generation-packages profile))))
391
392(defun guix-generation-packages-buffer (profile generation &optional system?)
393 "Return buffer with package outputs installed in PROFILE's GENERATION.
394Create the buffer if needed."
395 (let ((buf-name (guix-generation-packages-buffer-name
396 profile generation)))
397 (or (and (null guix-generation-packages-update-buffer)
398 (get-buffer buf-name))
399 (let ((buf (get-buffer-create buf-name)))
400 (guix-generation-insert-packages
401 buf
402 (guix-packages-profile profile generation system?))
403 buf))))
404
405(defun guix-profile-generation-manifest-file (generation)
406 "Return the file name of a GENERATION's manifest.
407GENERATION is a generation number of the current profile."
408 (guix-manifest-file (guix-ui-current-profile)
409 generation
410 (guix-system-generation?)))
411
412(defun guix-profile-generation-packages-buffer (generation)
413 "Insert GENERATION's package outputs in a buffer and return it.
414GENERATION is a generation number of the current profile."
415 (guix-generation-packages-buffer (guix-ui-current-profile)
416 generation
417 (guix-system-generation?)))
418
419
420;;; Interactive commands
421
422;;;###autoload
423(defun guix-generations (&optional profile)
424 "Display information about all generations.
425If PROFILE is nil, use `guix-current-profile'.
426Interactively with prefix, prompt for PROFILE."
427 (interactive (list (guix-ui-read-profile)))
428 (guix-generation-get-display profile 'all))
429
430;;;###autoload
431(defun guix-last-generations (number &optional profile)
432 "Display information about last NUMBER generations.
433If PROFILE is nil, use `guix-current-profile'.
434Interactively with prefix, prompt for PROFILE."
435 (interactive
436 (list (read-number "The number of last generations: ")
437 (guix-ui-read-profile)))
438 (guix-generation-get-display profile 'last number))
439
440;;;###autoload
441(defun guix-generations-by-time (from to &optional profile)
442 "Display information about generations created between FROM and TO.
443FROM and TO should be time values.
444If PROFILE is nil, use `guix-current-profile'.
445Interactively with prefix, prompt for PROFILE."
446 (interactive
447 (list (guix-read-date "Find generations (from): ")
448 (guix-read-date "Find generations (to): ")
449 (guix-ui-read-profile)))
450 (guix-generation-get-display profile 'time
451 (float-time from)
452 (float-time to)))
453
454(provide 'guix-ui-generation)
455
456;;; guix-ui-generation.el ends here
diff --git a/emacs/guix-ui-license.el b/emacs/guix-ui-license.el
deleted file mode 100644
index cf1b5cd357c..00000000000
--- a/emacs/guix-ui-license.el
+++ /dev/null
@@ -1,150 +0,0 @@
1;;; guix-ui-license.el --- Interface for displaying licenses
2
3;; Copyright © 2016 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 'list'/'info' interface for displaying licenses of
23;; Guix packages.
24
25;;; Code:
26
27(require 'guix-buffer)
28(require 'guix-list)
29(require 'guix-info)
30(require 'guix-backend)
31(require 'guix-guile)
32(require 'guix-license)
33
34(guix-define-entry-type license)
35
36(defun guix-license-get-entries (search-type &rest args)
37 "Receive 'license' entries.
38SEARCH-TYPE may be one of the following symbols: `all', `id', `name'."
39 (guix-eval-read
40 (apply #'guix-make-guile-expression
41 'license-entries search-type args)))
42
43(defun guix-license-get-display (search-type &rest args)
44 "Search for licenses and show results."
45 (apply #'guix-list-get-display-entries
46 'license search-type args))
47
48(defun guix-license-message (entries search-type &rest args)
49 "Display a message after showing license ENTRIES."
50 ;; Some objects in (guix licenses) module are procedures (e.g.,
51 ;; 'non-copyleft' or 'x11-style'). Such licenses cannot be "described".
52 (when (null entries)
53 (if (cdr args)
54 (message "Unknown licenses.")
55 (message "Unknown license."))))
56
57
58;;; License 'info'
59
60(guix-info-define-interface license
61 :buffer-name "*Guix License Info*"
62 :get-entries-function 'guix-license-get-entries
63 :message-function 'guix-license-message
64 :format '((name ignore (simple guix-info-heading))
65 ignore
66 guix-license-insert-packages-button
67 (url ignore (simple guix-url))
68 guix-license-insert-comment
69 ignore
70 guix-license-insert-file)
71 :titles '((url . "URL")))
72
73(declare-function guix-packages-by-license "guix-ui-package")
74
75(defun guix-license-insert-packages-button (entry)
76 "Insert button to display packages by license ENTRY."
77 (let ((license (guix-entry-value entry 'name)))
78 (guix-info-insert-action-button
79 "Packages"
80 (lambda (btn)
81 (guix-packages-by-license (button-get btn 'license)))
82 (format "Display packages with license '%s'" license)
83 'license license)))
84
85(defun guix-license-insert-comment (entry)
86 "Insert 'comment' of a license ENTRY."
87 (let ((comment (guix-entry-value entry 'comment)))
88 (if (and comment
89 (string-match-p "^http" comment))
90 (guix-info-insert-value-simple comment 'guix-url)
91 (guix-info-insert-title-simple
92 (guix-info-param-title 'license 'comment))
93 (guix-info-insert-value-indent comment))))
94
95(defun guix-license-insert-file (entry)
96 "Insert button to open license definition."
97 (let ((license (guix-entry-value entry 'name)))
98 (guix-insert-button
99 (guix-license-file) 'guix-file
100 'help-echo (format "Open definition of license '%s'" license)
101 'action (lambda (btn)
102 (guix-find-license-definition (button-get btn 'license)))
103 'license license)))
104
105
106;;; License 'list'
107
108(guix-list-define-interface license
109 :buffer-name "*Guix Licenses*"
110 :get-entries-function 'guix-license-get-entries
111 :describe-function 'guix-license-list-describe
112 :message-function 'guix-license-message
113 :format '((name nil 40 t)
114 (url guix-list-get-url 50 t))
115 :titles '((name . "License"))
116 :sort-key '(name))
117
118(let ((map guix-license-list-mode-map))
119 (define-key map (kbd "e") 'guix-license-list-edit)
120 (define-key map (kbd "RET") 'guix-license-list-show-packages))
121
122(defun guix-license-list-describe (ids)
123 "Describe licenses with IDS (list of identifiers)."
124 (guix-buffer-display-entries
125 (guix-entries-by-ids ids (guix-buffer-current-entries))
126 'info 'license (cl-list* 'id ids) 'add))
127
128(defun guix-license-list-show-packages ()
129 "Display packages with the license at point."
130 (interactive)
131 (guix-packages-by-license (guix-list-current-id)))
132
133(defun guix-license-list-edit (&optional directory)
134 "Go to the location of the current license definition.
135See `guix-license-file' for the meaning of DIRECTORY."
136 (interactive (list (guix-read-directory)))
137 (guix-find-license-definition (guix-list-current-id) directory))
138
139
140;;; Interactive commands
141
142;;;###autoload
143(defun guix-licenses ()
144 "Display licenses of the Guix packages."
145 (interactive)
146 (guix-license-get-display 'all))
147
148(provide 'guix-ui-license)
149
150;;; guix-ui-license.el ends here
diff --git a/emacs/guix-ui-location.el b/emacs/guix-ui-location.el
deleted file mode 100644
index 0027c1fba8e..00000000000
--- a/emacs/guix-ui-location.el
+++ /dev/null
@@ -1,83 +0,0 @@
1;;; guix-ui-location.el --- Interface for displaying package locations
2
3;; Copyright © 2016 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 Location as published by
9;; the Free Software Foundation, either version 3 of the Location, 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 Location for more details.
16
17;; You should have received a copy of the GNU General Public Location
18;; along with this program. If not, see <http://www.gnu.org/locations/>.
19
20;;; Commentary:
21
22;; This file provides a 'list' interface for displaying locations of Guix
23;; packages.
24
25;;; Code:
26
27(require 'guix-buffer)
28(require 'guix-list)
29(require 'guix-location)
30(require 'guix-backend)
31
32(guix-define-entry-type location)
33
34(defun guix-location-get-entries ()
35 "Receive 'package location' entries."
36 (guix-eval-read "(package-location-entries)"))
37
38
39;;; Location 'list'
40
41(guix-list-define-interface location
42 :buffer-name "*Guix Package Locations*"
43 :get-entries-function 'guix-location-get-entries
44 :format '((location guix-location-list-file-name-specification 50 t)
45 (number-of-packages nil 10 guix-list-sort-numerically-1
46 :right-align t))
47 :sort-key '(location))
48
49(let ((map guix-location-list-mode-map))
50 (define-key map (kbd "RET") 'guix-location-list-show-packages)
51 ;; "Location Info" buffer is not defined (it would be useless), so
52 ;; unbind "i" key (by default, it is used to display Info buffer).
53 (define-key map (kbd "i") nil))
54
55(defun guix-location-list-file-name-specification (location &optional _)
56 "Return LOCATION button specification for `tabulated-list-entries'."
57 (list location
58 'face 'guix-list-file-name
59 'action (lambda (btn)
60 (guix-find-location (button-get btn 'location)))
61 'follow-link t
62 'help-echo (concat "Find location: " location)
63 'location location))
64
65(declare-function guix-packages-by-location "guix-ui-package")
66
67(defun guix-location-list-show-packages ()
68 "Display packages placed in the location at point."
69 (interactive)
70 (guix-packages-by-location (guix-list-current-id)))
71
72
73;;; Interactive commands
74
75;;;###autoload
76(defun guix-locations ()
77 "Display locations of the Guix packages."
78 (interactive)
79 (guix-list-get-display-entries 'location))
80
81(provide 'guix-ui-location)
82
83;;; guix-ui-location.el ends here
diff --git a/emacs/guix-ui-package.el b/emacs/guix-ui-package.el
deleted file mode 100644
index 4280246bb82..00000000000
--- a/emacs/guix-ui-package.el
+++ /dev/null
@@ -1,1191 +0,0 @@
1;;; guix-ui-package.el --- Interface for displaying packages -*- lexical-binding: t -*-
2
3;; Copyright © 2014, 2015, 2016 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 an interface for displaying packages and outputs
23;; in 'list' and 'info' buffers, and commands for working with them.
24
25;;; Code:
26
27(require 'cl-lib)
28(require 'guix-buffer)
29(require 'guix-list)
30(require 'guix-info)
31(require 'guix-ui)
32(require 'guix-base)
33(require 'guix-backend)
34(require 'guix-guile)
35(require 'guix-entry)
36(require 'guix-utils)
37(require 'guix-hydra)
38(require 'guix-hydra-build)
39(require 'guix-read)
40(require 'guix-license)
41(require 'guix-location)
42(require 'guix-profiles)
43
44(guix-ui-define-entry-type package)
45(guix-ui-define-entry-type output)
46
47(defcustom guix-package-list-type 'output
48 "Define how to display packages in 'list' buffer.
49Should be a symbol `package' or `output' (if `output', display each
50output on a separate line; if `package', display each package on
51a separate line)."
52 :type '(choice (const :tag "List of packages" package)
53 (const :tag "List of outputs" output))
54 :group 'guix-package)
55
56(defcustom guix-package-info-type 'package
57 "Define how to display packages in 'info' buffer.
58Should be a symbol `package' or `output' (if `output', display
59each output separately; if `package', display outputs inside
60package data)."
61 :type '(choice (const :tag "Display packages" package)
62 (const :tag "Display outputs" output))
63 :group 'guix-package)
64
65(defun guix-package-get-display (profile search-type &rest search-values)
66 "Search for packages/outputs and show results.
67
68If PROFILE is nil, use `guix-current-profile'.
69
70See `guix-ui-get-entries' for the meaning of SEARCH-TYPE and
71SEARCH-VALUES.
72
73Results are displayed in the list buffer, unless a single package
74is found and `guix-package-list-single' is nil."
75 (let* ((args (cl-list* (or profile guix-current-profile)
76 search-type search-values))
77 (entries (guix-buffer-get-entries
78 'list guix-package-list-type args)))
79 (if (or guix-package-list-single
80 (null entries)
81 (cdr entries))
82 (guix-buffer-display-entries
83 entries 'list guix-package-list-type args 'add)
84 (guix-buffer-get-display-entries
85 'info guix-package-info-type args 'add))))
86
87(defun guix-package-entry->name-specification (entry &optional output)
88 "Return name specification of the package ENTRY and OUTPUT."
89 (guix-package-name-specification
90 (guix-entry-value entry 'name)
91 (guix-entry-value entry 'version)
92 (or output (guix-entry-value entry 'output))))
93
94(defun guix-package-entries->name-specifications (entries)
95 "Return name specifications by the package or output ENTRIES."
96 (cl-remove-duplicates (mapcar #'guix-package-entry->name-specification
97 entries)
98 :test #'string=))
99
100(defun guix-package-installed-outputs (entry)
101 "Return a list of installed outputs for the package ENTRY."
102 (mapcar (lambda (installed-entry)
103 (guix-entry-value installed-entry 'output))
104 (guix-entry-value entry 'installed)))
105
106(defun guix-package-id-and-output-by-output-id (output-id)
107 "Return a list (PACKAGE-ID OUTPUT) by OUTPUT-ID."
108 (cl-multiple-value-bind (package-id-str output)
109 (split-string output-id ":")
110 (let ((package-id (string-to-number package-id-str)))
111 (list (if (= 0 package-id) package-id-str package-id)
112 output))))
113
114(defun guix-package-build-log-file (id)
115 "Return build log file name of a package defined by ID."
116 (guix-eval-read
117 (guix-make-guile-expression 'package-build-log-file id)))
118
119(defun guix-package-find-build-log (id)
120 "Show build log of a package defined by ID."
121 (require 'guix-build-log)
122 (let ((file (guix-package-build-log-file id)))
123 (if file
124 (guix-build-log-find-file file)
125 (message "Couldn't find the package build log."))))
126
127
128;;; Processing package actions
129
130(defun guix-process-package-actions (profile actions
131 &optional operation-buffer)
132 "Process package ACTIONS on PROFILE.
133Each action is a list of the form:
134
135 (ACTION-TYPE PACKAGE-SPEC ...)
136
137ACTION-TYPE is one of the following symbols: `install',
138`upgrade', `remove'/`delete'.
139PACKAGE-SPEC should have the following form: (ID [OUTPUT] ...)."
140 (let (install upgrade remove)
141 (mapc (lambda (action)
142 (let ((action-type (car action))
143 (specs (cdr action)))
144 (cl-case action-type
145 (install (setq install (append install specs)))
146 (upgrade (setq upgrade (append upgrade specs)))
147 ((remove delete) (setq remove (append remove specs))))))
148 actions)
149 (when (guix-continue-package-operation-p
150 profile
151 :install install :upgrade upgrade :remove remove)
152 (guix-eval-in-repl
153 (guix-make-guile-expression
154 'process-package-actions profile
155 :install install :upgrade upgrade :remove remove
156 :use-substitutes? (or guix-use-substitutes 'f)
157 :dry-run? (or guix-dry-run 'f))
158 (and (not guix-dry-run) operation-buffer)))))
159
160(cl-defun guix-continue-package-operation-p (profile
161 &key install upgrade remove)
162 "Return non-nil if a package operation should be continued.
163Ask a user if needed (see `guix-operation-confirm').
164INSTALL, UPGRADE, REMOVE are 'package action specifications'.
165See `guix-process-package-actions' for details."
166 (or (null guix-operation-confirm)
167 (let* ((entries (guix-ui-get-entries
168 profile 'package 'id
169 (append (mapcar #'car install)
170 (mapcar #'car upgrade)
171 (mapcar #'car remove))
172 '(id name version location)))
173 (install-strings (guix-get-package-strings install entries))
174 (upgrade-strings (guix-get-package-strings upgrade entries))
175 (remove-strings (guix-get-package-strings remove entries)))
176 (if (or install-strings upgrade-strings remove-strings)
177 (let ((buf (get-buffer-create guix-temp-buffer-name)))
178 (with-current-buffer buf
179 (setq-local cursor-type nil)
180 (setq buffer-read-only nil)
181 (erase-buffer)
182 (insert "Profile: " profile "\n\n")
183 (guix-insert-package-strings install-strings "install")
184 (guix-insert-package-strings upgrade-strings "upgrade")
185 (guix-insert-package-strings remove-strings "remove")
186 (let ((win (temp-buffer-window-show
187 buf
188 '((display-buffer-reuse-window
189 display-buffer-at-bottom)
190 (window-height . fit-window-to-buffer)))))
191 (prog1 (guix-operation-prompt)
192 (quit-window nil win)))))
193 (message "Nothing to be done.
194If Guix REPL was restarted, the data is not up-to-date.")
195 nil))))
196
197(defun guix-get-package-strings (specs entries)
198 "Return short package descriptions for performing package actions.
199See `guix-process-package-actions' for the meaning of SPECS.
200ENTRIES is a list of package entries to get info about packages."
201 (delq nil
202 (mapcar
203 (lambda (spec)
204 (let* ((id (car spec))
205 (outputs (cdr spec))
206 (entry (guix-entry-by-id id entries)))
207 (when entry
208 (let ((location (guix-entry-value entry 'location)))
209 (concat (guix-package-entry->name-specification entry)
210 (when outputs
211 (concat ":"
212 (guix-concat-strings outputs ",")))
213 (when location
214 (concat "\t(" location ")")))))))
215 specs)))
216
217(defun guix-insert-package-strings (strings action)
218 "Insert information STRINGS at point for performing package ACTION."
219 (when strings
220 (insert "Package(s) to " (propertize action 'face 'bold) ":\n")
221 (mapc (lambda (str)
222 (insert " " str "\n"))
223 strings)
224 (insert "\n")))
225
226
227;;; Package 'info'
228
229(guix-ui-info-define-interface package
230 :buffer-name "*Guix Package Info*"
231 :format '(guix-package-info-insert-heading
232 ignore
233 (synopsis ignore (simple guix-package-info-synopsis))
234 ignore
235 (description ignore (simple guix-package-info-description))
236 ignore
237 (outputs simple guix-package-info-insert-outputs)
238 guix-package-info-insert-misc
239 (source simple guix-package-info-insert-source)
240 (location simple guix-package-info-insert-location)
241 (home-url format (format guix-url))
242 (license format (format guix-package-license))
243 (systems format guix-package-info-insert-systems)
244 (inputs format (format guix-package-input))
245 (native-inputs format (format guix-package-native-input))
246 (propagated-inputs format
247 (format guix-package-propagated-input)))
248 :titles '((home-url . "Home page")
249 (systems . "Supported systems"))
250 :required '(id name version installed non-unique))
251
252(guix-info-define-interface installed-output
253 :format '((path simple (indent guix-file))
254 (dependencies simple (indent guix-file)))
255 :titles '((path . "Store directory"))
256 :reduced? t)
257
258(defface guix-package-info-heading
259 '((t :inherit guix-info-heading))
260 "Face for package name and version headings."
261 :group 'guix-package-info-faces)
262
263(defface guix-package-info-name
264 '((t :inherit font-lock-keyword-face))
265 "Face used for a name of a package."
266 :group 'guix-package-info-faces)
267
268(defface guix-package-info-name-button
269 '((t :inherit button))
270 "Face used for a full name that can be used to describe a package."
271 :group 'guix-package-info-faces)
272
273(defface guix-package-info-version
274 '((t :inherit font-lock-builtin-face))
275 "Face used for a version of a package."
276 :group 'guix-package-info-faces)
277
278(defface guix-package-info-synopsis
279 '((((type tty pc) (class color)) :weight bold)
280 (t :height 1.1 :weight bold :inherit variable-pitch))
281 "Face used for a synopsis of a package."
282 :group 'guix-package-info-faces)
283
284(defface guix-package-info-description
285 '((t))
286 "Face used for a description of a package."
287 :group 'guix-package-info-faces)
288
289(defface guix-package-info-license
290 '((t :inherit font-lock-string-face))
291 "Face used for a license of a package."
292 :group 'guix-package-info-faces)
293
294(defface guix-package-info-location
295 '((t :inherit link))
296 "Face used for a location of a package."
297 :group 'guix-package-info-faces)
298
299(defface guix-package-info-source
300 '((t :inherit link :underline nil))
301 "Face used for a source URL of a package."
302 :group 'guix-package-info-faces)
303
304(defface guix-package-info-installed-outputs
305 '((default :weight bold)
306 (((class color) (min-colors 88) (background light))
307 :foreground "ForestGreen")
308 (((class color) (min-colors 88) (background dark))
309 :foreground "PaleGreen")
310 (((class color) (min-colors 8))
311 :foreground "green")
312 (t :underline t))
313 "Face used for installed outputs of a package."
314 :group 'guix-package-info-faces)
315
316(defface guix-package-info-uninstalled-outputs
317 '((t :weight bold))
318 "Face used for uninstalled outputs of a package."
319 :group 'guix-package-info-faces)
320
321(defface guix-package-info-obsolete
322 '((t :inherit error))
323 "Face used if a package is obsolete."
324 :group 'guix-package-info-faces)
325
326(defcustom guix-package-info-auto-find-package t
327 "If non-nil, open store directory after pressing \"Show\" package button.
328If nil, just display the store directory (or directories) without finding."
329 :type 'boolean
330 :group 'guix-package-info)
331
332(defcustom guix-package-info-auto-find-source nil
333 "If non-nil, open source file after pressing \"Show\" source button.
334If nil, just display the source file name without finding."
335 :type 'boolean
336 :group 'guix-package-info)
337
338(defcustom guix-package-info-auto-download-source t
339 "If nil, do not automatically download a source file if it doesn't exist.
340After pressing a \"Show\" button, a derivation of the package
341source is calculated and a store file path is displayed. If this
342variable is non-nil and the source file does not exist in the
343store, it will be automatically downloaded (with a possible
344prompt depending on `guix-operation-confirm' variable)."
345 :type 'boolean
346 :group 'guix-package-info)
347
348(defcustom guix-package-info-button-functions
349 '(guix-package-info-insert-build-button
350 guix-package-info-insert-build-log-button)
351 "List of functions used to insert package buttons in Info buffer.
352Each function is called with 2 arguments: package ID and full name."
353 :type '(repeat function)
354 :group 'guix-package-info)
355
356(defvar guix-package-info-download-buffer nil
357 "Buffer from which a current download operation was performed.")
358
359(defvar guix-package-info-output-format "%-10s"
360 "String used to format output names of the packages.
361It should be a '%s'-sequence. After inserting an output name
362formatted with this string, an action button is inserted.")
363
364(defvar guix-package-info-obsolete-string "(This package is obsolete)"
365 "String used if a package is obsolete.")
366
367(define-button-type 'guix-package-location
368 :supertype 'guix
369 'face 'guix-package-info-location
370 'help-echo "Find location of this package"
371 'action (lambda (btn)
372 (guix-find-location (button-label btn))))
373
374(define-button-type 'guix-package-license
375 :supertype 'guix
376 'face 'guix-package-info-license
377 'help-echo "Display license info"
378 'action (lambda (btn)
379 (require 'guix-ui-license)
380 (guix-buffer-get-display-entries
381 'info 'license
382 (list 'name (button-label btn))
383 'add)))
384
385(define-button-type 'guix-package-name
386 :supertype 'guix
387 'face 'guix-package-info-name-button
388 'help-echo "Describe this package"
389 'action (lambda (btn)
390 (guix-buffer-get-display-entries-current
391 'info guix-package-info-type
392 (list (guix-ui-current-profile)
393 'name (or (button-get btn 'spec)
394 (button-label btn)))
395 'add)))
396
397(define-button-type 'guix-package-heading
398 :supertype 'guix-package-name
399 'face 'guix-package-info-heading)
400
401(define-button-type 'guix-package-source
402 :supertype 'guix
403 'face 'guix-package-info-source
404 'help-echo ""
405 'action (lambda (_)
406 ;; As a source may not be a real URL (e.g., "mirror://..."),
407 ;; no action is bound to a source button.
408 (message "Yes, this is the source URL. What did you expect?")))
409
410(defun guix-package-info-insert-heading (entry)
411 "Insert package ENTRY heading (name and version) at point."
412 (guix-insert-button
413 (concat (guix-entry-value entry 'name) " "
414 (guix-entry-value entry 'version))
415 'guix-package-heading
416 'spec (guix-package-entry->name-specification entry)))
417
418(defun guix-package-info-insert-location (location &optional _)
419 "Insert package LOCATION at point."
420 (if (null location)
421 (guix-format-insert nil)
422 (let ((location-file (car (split-string location ":"))))
423 (guix-info-insert-value-indent location 'guix-package-location)
424 ;; Do not show "Packages" button if a package 'from file' is displayed.
425 (unless (eq (guix-ui-current-search-type) 'from-file)
426 (guix-info-insert-indent)
427 (guix-info-insert-action-button
428 "Packages"
429 (lambda (btn)
430 (guix-package-get-display (guix-ui-current-profile)
431 'location
432 (button-get btn 'location)))
433 (format "Display packages from location '%s'" location-file)
434 'location location-file)))))
435
436(defun guix-package-info-insert-systems (systems entry)
437 "Insert supported package SYSTEMS at point."
438 (guix-info-insert-value-format
439 systems 'guix-hydra-build-system
440 'action (lambda (btn)
441 (let ((args (guix-hydra-build-latest-prompt-args
442 :job (button-get btn 'job-name)
443 :system (button-label btn))))
444 (apply #'guix-hydra-build-get-display
445 'latest args)))
446 'job-name (guix-hydra-job-name-specification
447 (guix-entry-value entry 'name)
448 (guix-entry-value entry 'version))))
449
450(defmacro guix-package-info-define-insert-inputs (&optional type)
451 "Define a face and a function for inserting package inputs.
452TYPE is a type of inputs.
453Function name is `guix-package-info-insert-TYPE-inputs'.
454Face name is `guix-package-info-TYPE-inputs'."
455 (let* ((type-str (symbol-name type))
456 (type-name (and type (concat type-str "-")))
457 (type-desc (and type (concat type-str " ")))
458 (face (intern (concat "guix-package-info-" type-name "inputs")))
459 (btn (intern (concat "guix-package-" type-name "input"))))
460 `(progn
461 (defface ,face
462 '((t :inherit guix-package-info-name-button))
463 ,(concat "Face used for " type-desc "inputs of a package.")
464 :group 'guix-package-info-faces)
465
466 (define-button-type ',btn
467 :supertype 'guix-package-name
468 'face ',face))))
469
470(guix-package-info-define-insert-inputs)
471(guix-package-info-define-insert-inputs native)
472(guix-package-info-define-insert-inputs propagated)
473
474(defun guix-package-info-insert-outputs (outputs entry)
475 "Insert OUTPUTS from package ENTRY at point."
476 (and (guix-entry-value entry 'obsolete)
477 (guix-package-info-insert-obsolete-text))
478 (and (guix-entry-value entry 'non-unique)
479 (guix-entry-value entry 'installed)
480 (guix-package-info-insert-non-unique-text
481 (guix-package-entry->name-specification entry)))
482 (insert "\n")
483 (dolist (output outputs)
484 (guix-package-info-insert-output output entry)))
485
486(defun guix-package-info-insert-obsolete-text ()
487 "Insert a message about obsolete package at point."
488 (guix-info-insert-indent)
489 (guix-format-insert guix-package-info-obsolete-string
490 'guix-package-info-obsolete))
491
492(defun guix-package-info-insert-non-unique-text (full-name)
493 "Insert a message about non-unique package with FULL-NAME at point."
494 (insert "\n")
495 (guix-info-insert-indent)
496 (insert "Installed outputs are displayed for a non-unique ")
497 (guix-insert-button full-name 'guix-package-name)
498 (insert " package."))
499
500(defun guix-package-info-insert-output (output entry)
501 "Insert OUTPUT at point.
502Make some fancy text with buttons and additional stuff if the
503current OUTPUT is installed (if there is such output in
504`installed' parameter of a package ENTRY)."
505 (let* ((installed (guix-entry-value entry 'installed))
506 (obsolete (guix-entry-value entry 'obsolete))
507 (installed-entry (cl-find-if
508 (lambda (entry)
509 (string= (guix-entry-value entry 'output)
510 output))
511 installed))
512 (action-type (if installed-entry 'delete 'install))
513 (profile (guix-ui-current-profile)))
514 (guix-info-insert-indent)
515 (guix-format-insert output
516 (if installed-entry
517 'guix-package-info-installed-outputs
518 'guix-package-info-uninstalled-outputs)
519 guix-package-info-output-format)
520 ;; Do not allow a user to install/delete anything to/from a system
521 ;; profile, so add action buttons only for non-system profiles.
522 (when (and profile
523 (not (guix-system-profile? profile)))
524 (guix-package-info-insert-action-button action-type entry output)
525 (when obsolete
526 (guix-info-insert-indent)
527 (guix-package-info-insert-action-button 'upgrade entry output)))
528 (insert "\n")
529 (when installed-entry
530 (guix-info-insert-entry installed-entry 'installed-output 2))))
531
532(defun guix-package-info-insert-action-button (type entry output)
533 "Insert button to process an action on a package OUTPUT at point.
534TYPE is one of the following symbols: `install', `delete', `upgrade'.
535ENTRY is an alist with package info."
536 (let ((type-str (capitalize (symbol-name type)))
537 (full-name (guix-package-entry->name-specification entry output)))
538 (guix-info-insert-action-button
539 type-str
540 (lambda (btn)
541 (guix-process-package-actions
542 (guix-ui-current-profile)
543 `((,(button-get btn 'action-type) (,(button-get btn 'id)
544 ,(button-get btn 'output))))
545 (current-buffer)))
546 (concat type-str " '" full-name "'")
547 'action-type type
548 'id (or (guix-entry-value entry 'package-id)
549 (guix-entry-id entry))
550 'output output)))
551
552(defun guix-package-info-show-store-path (entry-id package-id)
553 "Show store directories of the package outputs in the current buffer.
554ENTRY-ID is an ID of the current entry (package or output).
555PACKAGE-ID is an ID of the package which store path to show."
556 (let* ((entries (guix-buffer-current-entries))
557 (entry (guix-entry-by-id entry-id entries))
558 (dirs (guix-package-store-path package-id)))
559 (or dirs
560 (error "Couldn't define store directory of the package"))
561 (let* ((new-entry (cons (cons 'store-path dirs)
562 entry))
563 (new-entries (guix-replace-entry entry-id new-entry entries)))
564 (setf (guix-buffer-item-entries guix-buffer-item)
565 new-entries)
566 (guix-buffer-redisplay-goto-button)
567 (let ((dir (car dirs)))
568 (if (file-exists-p dir)
569 (if guix-package-info-auto-find-package
570 (find-file dir)
571 (message nil))
572 (message "'%s' does not exist.\nTry to build this package."
573 dir))))))
574
575(defun guix-package-info-insert-misc (entry)
576 "Insert various buttons and other info for package ENTRY at point."
577 (if (guix-entry-value entry 'obsolete)
578 (guix-format-insert nil)
579 (let* ((entry-id (guix-entry-id entry))
580 (package-id (or (guix-entry-value entry 'package-id)
581 entry-id))
582 (full-name (guix-package-entry->name-specification entry))
583 (store-path (guix-entry-value entry 'store-path)))
584 (guix-info-insert-title-simple "Package")
585 (if store-path
586 (guix-info-insert-value-indent store-path 'guix-file)
587 (guix-info-insert-action-button
588 "Show"
589 (lambda (btn)
590 (guix-package-info-show-store-path
591 (button-get btn 'entry-id)
592 (button-get btn 'package-id)))
593 "Show the store directory of the current package"
594 'entry-id entry-id
595 'package-id package-id))
596 (when guix-package-info-button-functions
597 (insert "\n")
598 (guix-mapinsert (lambda (fun)
599 (funcall fun package-id full-name))
600 guix-package-info-button-functions
601 (guix-info-get-indent)
602 :indent guix-info-indent
603 :column (guix-info-fill-column))))))
604
605(defun guix-package-info-insert-build-button (id full-name)
606 "Insert button to build a package defined by ID."
607 (guix-info-insert-action-button
608 "Build"
609 (lambda (btn)
610 (guix-build-package (button-get btn 'id)
611 (format "Build '%s' package?" full-name)))
612 (format "Build the current package")
613 'id id))
614
615(defun guix-package-info-insert-build-log-button (id _name)
616 "Insert button to show build log of a package defined by ID."
617 (guix-info-insert-action-button
618 "Build Log"
619 (lambda (btn)
620 (guix-package-find-build-log (button-get btn 'id)))
621 "View build log of the current package"
622 'id id))
623
624(defun guix-package-info-show-source (entry-id package-id)
625 "Show file name of a package source in the current info buffer.
626Find the file if needed (see `guix-package-info-auto-find-source').
627ENTRY-ID is an ID of the current entry (package or output).
628PACKAGE-ID is an ID of the package which source to show."
629 (let* ((entries (guix-buffer-current-entries))
630 (entry (guix-entry-by-id entry-id entries))
631 (file (guix-package-source-path package-id)))
632 (or file
633 (error "Couldn't define file name of the package source"))
634 (let* ((new-entry (cons (cons 'source-file file)
635 entry))
636 (new-entries (guix-replace-entry entry-id new-entry entries)))
637 (setf (guix-buffer-item-entries guix-buffer-item)
638 new-entries)
639 (guix-buffer-redisplay-goto-button)
640 (if (file-exists-p file)
641 (if guix-package-info-auto-find-source
642 (guix-find-file file)
643 (message "The source store path is displayed."))
644 (if guix-package-info-auto-download-source
645 (guix-package-info-download-source package-id)
646 (message "The source does not exist in the store."))))))
647
648(defun guix-package-info-download-source (package-id)
649 "Download a source of the package PACKAGE-ID."
650 (setq guix-package-info-download-buffer (current-buffer))
651 (guix-package-source-build-derivation
652 package-id
653 "The source does not exist in the store. Download it?"))
654
655(defun guix-package-info-insert-source (source entry)
656 "Insert SOURCE from package ENTRY at point.
657SOURCE is a list of URLs."
658 (if (null source)
659 (guix-format-insert nil)
660 (let* ((source-file (guix-entry-value entry 'source-file))
661 (entry-id (guix-entry-id entry))
662 (package-id (or (guix-entry-value entry 'package-id)
663 entry-id)))
664 (if (null source-file)
665 (guix-info-insert-action-button
666 "Show"
667 (lambda (btn)
668 (guix-package-info-show-source (button-get btn 'entry-id)
669 (button-get btn 'package-id)))
670 "Show the source store directory of the current package"
671 'entry-id entry-id
672 'package-id package-id)
673 (unless (file-exists-p source-file)
674 (guix-info-insert-action-button
675 "Download"
676 (lambda (btn)
677 (guix-package-info-download-source
678 (button-get btn 'package-id)))
679 "Download the source into the store"
680 'package-id package-id))
681 (guix-info-insert-value-indent source-file 'guix-file))
682 (guix-info-insert-value-indent source 'guix-package-source))))
683
684(defun guix-package-info-redisplay-after-download ()
685 "Redisplay an 'info' buffer after downloading the package source.
686This function is used to hide a \"Download\" button if needed."
687 (when (buffer-live-p guix-package-info-download-buffer)
688 (with-current-buffer guix-package-info-download-buffer
689 (guix-buffer-redisplay-goto-button))
690 (setq guix-package-info-download-buffer nil)))
691
692(add-hook 'guix-after-source-download-hook
693 'guix-package-info-redisplay-after-download)
694
695
696;;; Package 'list'
697
698(guix-ui-list-define-interface package
699 :buffer-name "*Guix Package List*"
700 :format '((name guix-package-list-get-name 20 t)
701 (version nil 10 nil)
702 (outputs nil 13 t)
703 (installed guix-package-list-get-installed-outputs 13 t)
704 (synopsis guix-list-get-one-line 30 nil))
705 :sort-key '(name)
706 :marks '((install . ?I)
707 (upgrade . ?U)
708 (delete . ?D)))
709
710(let ((map guix-package-list-mode-map))
711 (define-key map (kbd "B") 'guix-package-list-latest-builds)
712 (define-key map (kbd "e") 'guix-package-list-edit)
713 (define-key map (kbd "x") 'guix-package-list-execute)
714 (define-key map (kbd "i") 'guix-package-list-mark-install)
715 (define-key map (kbd "d") 'guix-package-list-mark-delete)
716 (define-key map (kbd "U") 'guix-package-list-mark-upgrade)
717 (define-key map (kbd "^") 'guix-package-list-mark-upgrades))
718
719(defface guix-package-list-installed
720 '((t :inherit guix-package-info-installed-outputs))
721 "Face used if there are installed outputs for the current package."
722 :group 'guix-package-list-faces)
723
724(defface guix-package-list-obsolete
725 '((t :inherit guix-package-info-obsolete))
726 "Face used if a package is obsolete."
727 :group 'guix-package-list-faces)
728
729(defcustom guix-package-list-generation-marking-enabled nil
730 "If non-nil, allow putting marks in a list with 'generation packages'.
731
732By default this is disabled, because it may be confusing. For
733example, a package is installed in some generation, so a user can
734mark it for deletion in the list of packages from this
735generation, but the package may not be installed in the latest
736generation, so actually it cannot be deleted.
737
738If you managed to understand the explanation above or if you
739really know what you do or if you just don't care, you can set
740this variable to t. It should not do much harm anyway (most
741likely)."
742 :type 'boolean
743 :group 'guix-package-list)
744
745(defun guix-package-list-get-name (name entry)
746 "Return NAME of the package ENTRY.
747Colorize it with `guix-package-list-installed' or
748`guix-package-list-obsolete' if needed."
749 (guix-get-string name
750 (cond ((guix-entry-value entry 'obsolete)
751 'guix-package-list-obsolete)
752 ((guix-entry-value entry 'installed)
753 'guix-package-list-installed))))
754
755(defun guix-package-list-get-installed-outputs (installed &optional _)
756 "Return string with outputs from INSTALLED entries."
757 (guix-get-string
758 (mapcar (lambda (entry)
759 (guix-entry-value entry 'output))
760 installed)))
761
762(defun guix-package-list-marking-check ()
763 "Signal an error if marking is disabled for the current buffer."
764 (when (and (not guix-package-list-generation-marking-enabled)
765 (or (derived-mode-p 'guix-package-list-mode)
766 (derived-mode-p 'guix-output-list-mode))
767 (eq (guix-ui-current-search-type) 'generation))
768 (error "Action marks are disabled for lists of 'generation packages'")))
769
770(defun guix-package-list-mark-outputs (mark default
771 &optional prompt available)
772 "Mark the current package with MARK and move to the next line.
773If PROMPT is non-nil, use it to ask a user for outputs from
774AVAILABLE list, otherwise mark all DEFAULT outputs."
775 (let ((outputs (if prompt
776 (guix-completing-read-multiple
777 prompt available nil t)
778 default)))
779 (apply #'guix-list--mark mark t outputs)))
780
781(defun guix-package-list-mark-install (&optional arg)
782 "Mark the current package for installation and move to the next line.
783With ARG, prompt for the outputs to install (several outputs may
784be separated with \",\")."
785 (interactive "P")
786 (guix-package-list-marking-check)
787 (let* ((entry (guix-list-current-entry))
788 (all (guix-entry-value entry 'outputs))
789 (installed (guix-package-installed-outputs entry))
790 (available (cl-set-difference all installed :test #'string=)))
791 (or available
792 (user-error "This package is already installed"))
793 (guix-package-list-mark-outputs
794 'install '("out")
795 (and arg "Output(s) to install: ")
796 available)))
797
798(defun guix-package-list-mark-delete (&optional arg)
799 "Mark the current package for deletion and move to the next line.
800With ARG, prompt for the outputs to delete (several outputs may
801be separated with \",\")."
802 (interactive "P")
803 (guix-package-list-marking-check)
804 (let* ((entry (guix-list-current-entry))
805 (installed (guix-package-installed-outputs entry)))
806 (or installed
807 (user-error "This package is not installed"))
808 (guix-package-list-mark-outputs
809 'delete installed
810 (and arg "Output(s) to delete: ")
811 installed)))
812
813(defun guix-package-list-mark-upgrade (&optional arg)
814 "Mark the current package for upgrading and move to the next line.
815With ARG, prompt for the outputs to upgrade (several outputs may
816be separated with \",\")."
817 (interactive "P")
818 (guix-package-list-marking-check)
819 (let* ((entry (guix-list-current-entry))
820 (installed (guix-package-installed-outputs entry)))
821 (or installed
822 (user-error "This package is not installed"))
823 (when (or (guix-entry-value entry 'obsolete)
824 (y-or-n-p "This package is not obsolete. Try to upgrade it anyway? "))
825 (guix-package-list-mark-outputs
826 'upgrade installed
827 (and arg "Output(s) to upgrade: ")
828 installed))))
829
830(defun guix-package-mark-upgrades (fun)
831 "Mark all obsolete packages for upgrading.
832Use FUN to perform marking of the current line. FUN should
833take an entry as argument."
834 (guix-package-list-marking-check)
835 (let ((obsolete (cl-remove-if-not
836 (lambda (entry)
837 (guix-entry-value entry 'obsolete))
838 (guix-buffer-current-entries))))
839 (guix-list-for-each-line
840 (lambda ()
841 (let* ((id (guix-list-current-id))
842 (entry (cl-find-if
843 (lambda (entry)
844 (equal id (guix-entry-id entry)))
845 obsolete)))
846 (when entry
847 (funcall fun entry)))))))
848
849(defun guix-package-list-mark-upgrades ()
850 "Mark all obsolete packages for upgrading."
851 (interactive)
852 (guix-package-mark-upgrades
853 (lambda (entry)
854 (apply #'guix-list--mark
855 'upgrade nil
856 (guix-package-installed-outputs entry)))))
857
858(defun guix-package-assert-non-system-profile ()
859 "Verify that the current profile is not a system one.
860The current profile is the one used by the current buffer."
861 (let ((profile (guix-ui-current-profile)))
862 (and profile
863 (guix-system-profile? profile)
864 (user-error "Packages cannot be installed or removed to/from \
865profile '%s'.
866Use 'guix system reconfigure' shell command to modify a system profile."
867 profile))))
868
869(defun guix-package-execute-actions (fun)
870 "Perform actions on the marked packages.
871Use FUN to define actions suitable for `guix-process-package-actions'.
872FUN should take action-type as argument."
873 (guix-package-assert-non-system-profile)
874 (let ((actions (delq nil
875 (mapcar fun '(install delete upgrade)))))
876 (if actions
877 (guix-process-package-actions (guix-ui-current-profile)
878 actions (current-buffer))
879 (user-error "No operations specified"))))
880
881(defun guix-package-list-execute ()
882 "Perform actions on the marked packages."
883 (interactive)
884 (guix-package-execute-actions #'guix-package-list-make-action))
885
886(defun guix-package-list-make-action (action-type)
887 "Return action specification for the packages marked with ACTION-TYPE.
888Return nil, if there are no packages marked with ACTION-TYPE.
889The specification is suitable for `guix-process-package-actions'."
890 (let ((specs (guix-list-get-marked-args action-type)))
891 (and specs (cons action-type specs))))
892
893(defun guix-package-list-edit (&optional directory)
894 "Go to the location of the current package.
895See `guix-find-location' for the meaning of DIRECTORY."
896 (interactive (list (guix-read-directory)))
897 (guix-edit (guix-list-current-id) directory))
898
899(defun guix-package-list-latest-builds (number &rest args)
900 "Display latest NUMBER of Hydra builds of the current package.
901Interactively, prompt for NUMBER. With prefix argument, prompt
902for all ARGS."
903 (interactive
904 (let ((entry (guix-list-current-entry)))
905 (guix-hydra-build-latest-prompt-args
906 :job (guix-hydra-job-name-specification
907 (guix-entry-value entry 'name)
908 (guix-entry-value entry 'version)))))
909 (apply #'guix-hydra-latest-builds number args))
910
911
912;;; Output 'info'
913
914(guix-ui-info-define-interface output
915 :buffer-name "*Guix Package Info*"
916 :format '((name format (format guix-package-info-name))
917 (version format guix-output-info-insert-version)
918 (output format guix-output-info-insert-output)
919 (synopsis simple (indent guix-package-info-synopsis))
920 guix-package-info-insert-misc
921 (source simple guix-package-info-insert-source)
922 (path simple (indent guix-file))
923 (dependencies simple (indent guix-file))
924 (location simple guix-package-info-insert-location)
925 (home-url format (format guix-url))
926 (license format (format guix-package-license))
927 (systems format guix-package-info-insert-systems)
928 (inputs format (format guix-package-input))
929 (native-inputs format (format guix-package-native-input))
930 (propagated-inputs format
931 (format guix-package-propagated-input))
932 (description simple (indent guix-package-info-description)))
933 :titles guix-package-info-titles
934 :required '(id package-id installed non-unique))
935
936(defun guix-output-info-insert-version (version entry)
937 "Insert output VERSION and obsolete text if needed at point."
938 (guix-info-insert-value-format version
939 'guix-package-info-version)
940 (and (guix-entry-value entry 'obsolete)
941 (guix-package-info-insert-obsolete-text)))
942
943(defun guix-output-info-insert-output (output entry)
944 "Insert OUTPUT and action buttons at point."
945 (let* ((installed (guix-entry-value entry 'installed))
946 (obsolete (guix-entry-value entry 'obsolete))
947 (action-type (if installed 'delete 'install)))
948 (guix-info-insert-value-format
949 output
950 (if installed
951 'guix-package-info-installed-outputs
952 'guix-package-info-uninstalled-outputs))
953 (guix-info-insert-indent)
954 (guix-package-info-insert-action-button action-type entry output)
955 (when obsolete
956 (guix-info-insert-indent)
957 (guix-package-info-insert-action-button 'upgrade entry output))))
958
959
960;;; Output 'list'
961
962(guix-ui-list-define-interface output
963 :buffer-name "*Guix Package List*"
964 :describe-function 'guix-output-list-describe
965 :format '((name guix-package-list-get-name 20 t)
966 (version nil 10 nil)
967 (output nil 9 t)
968 (installed nil 12 t)
969 (synopsis guix-list-get-one-line 30 nil))
970 :required '(id package-id)
971 :sort-key '(name)
972 :marks '((install . ?I)
973 (upgrade . ?U)
974 (delete . ?D)))
975
976(let ((map guix-output-list-mode-map))
977 (define-key map (kbd "B") 'guix-package-list-latest-builds)
978 (define-key map (kbd "e") 'guix-output-list-edit)
979 (define-key map (kbd "x") 'guix-output-list-execute)
980 (define-key map (kbd "i") 'guix-output-list-mark-install)
981 (define-key map (kbd "d") 'guix-output-list-mark-delete)
982 (define-key map (kbd "U") 'guix-output-list-mark-upgrade)
983 (define-key map (kbd "^") 'guix-output-list-mark-upgrades))
984
985(defun guix-output-list-mark-install ()
986 "Mark the current output for installation and move to the next line."
987 (interactive)
988 (guix-package-list-marking-check)
989 (let* ((entry (guix-list-current-entry))
990 (installed (guix-entry-value entry 'installed)))
991 (if installed
992 (user-error "This output is already installed")
993 (guix-list--mark 'install t))))
994
995(defun guix-output-list-mark-delete ()
996 "Mark the current output for deletion and move to the next line."
997 (interactive)
998 (guix-package-list-marking-check)
999 (let* ((entry (guix-list-current-entry))
1000 (installed (guix-entry-value entry 'installed)))
1001 (if installed
1002 (guix-list--mark 'delete t)
1003 (user-error "This output is not installed"))))
1004
1005(defun guix-output-list-mark-upgrade ()
1006 "Mark the current output for upgrading and move to the next line."
1007 (interactive)
1008 (guix-package-list-marking-check)
1009 (let* ((entry (guix-list-current-entry))
1010 (installed (guix-entry-value entry 'installed)))
1011 (or installed
1012 (user-error "This output is not installed"))
1013 (when (or (guix-entry-value entry 'obsolete)
1014 (y-or-n-p "This output is not obsolete. Try to upgrade it anyway? "))
1015 (guix-list--mark 'upgrade t))))
1016
1017(defun guix-output-list-mark-upgrades ()
1018 "Mark all obsolete package outputs for upgrading."
1019 (interactive)
1020 (guix-package-mark-upgrades
1021 (lambda (_) (guix-list--mark 'upgrade))))
1022
1023(defun guix-output-list-execute ()
1024 "Perform actions on the marked outputs."
1025 (interactive)
1026 (guix-package-execute-actions #'guix-output-list-make-action))
1027
1028(defun guix-output-list-make-action (action-type)
1029 "Return action specification for the outputs marked with ACTION-TYPE.
1030Return nil, if there are no outputs marked with ACTION-TYPE.
1031The specification is suitable for `guix-process-output-actions'."
1032 (let ((ids (guix-list-get-marked-id-list action-type)))
1033 (and ids (cons action-type
1034 (mapcar #'guix-package-id-and-output-by-output-id
1035 ids)))))
1036
1037(defun guix-output-list-describe (ids)
1038 "Describe outputs with IDS (list of output identifiers).
1039See `guix-package-info-type'."
1040 (if (eq guix-package-info-type 'output)
1041 (guix-buffer-get-display-entries
1042 'info 'output
1043 (cl-list* (guix-ui-current-profile) 'id ids)
1044 'add)
1045 (let ((pids (mapcar (lambda (oid)
1046 (car (guix-package-id-and-output-by-output-id
1047 oid)))
1048 ids)))
1049 (guix-buffer-get-display-entries
1050 'info 'package
1051 (cl-list* (guix-ui-current-profile)
1052 'id (cl-remove-duplicates pids))
1053 'add))))
1054
1055(defun guix-output-list-edit (&optional directory)
1056 "Go to the location of the current package.
1057See `guix-find-location' for the meaning of DIRECTORY."
1058 (interactive (list (guix-read-directory)))
1059 (guix-edit (guix-entry-value (guix-list-current-entry)
1060 'package-id)
1061 directory))
1062
1063
1064;;; Interactive commands
1065
1066(defvar guix-package-search-params '(name synopsis description)
1067 "Default list of package parameters for searching by regexp.")
1068
1069(defvar guix-package-search-history nil
1070 "A history of minibuffer prompts.")
1071
1072;;;###autoload
1073(defun guix-packages-by-name (name &optional profile)
1074 "Display Guix packages with NAME.
1075NAME is a string with name specification. It may optionally contain
1076a version number. Examples: \"guile\", \"guile@2.0.11\".
1077
1078If PROFILE is nil, use `guix-current-profile'.
1079Interactively with prefix, prompt for PROFILE."
1080 (interactive
1081 (list (guix-read-package-name)
1082 (guix-ui-read-profile)))
1083 (guix-package-get-display profile 'name name))
1084
1085;;;###autoload
1086(defun guix-packages-by-license (license &optional profile)
1087 "Display Guix packages with LICENSE.
1088LICENSE is a license name string.
1089If PROFILE is nil, use `guix-current-profile'.
1090Interactively with prefix, prompt for PROFILE."
1091 (interactive
1092 (list (guix-read-license-name)
1093 (guix-ui-read-profile)))
1094 (guix-package-get-display profile 'license license))
1095
1096;;;###autoload
1097(defun guix-packages-by-location (location &optional profile)
1098 "Display Guix packages placed in LOCATION file.
1099If PROFILE is nil, use `guix-current-profile'.
1100Interactively with prefix, prompt for PROFILE."
1101 (interactive
1102 (list (guix-read-package-location)
1103 (guix-ui-read-profile)))
1104 (guix-package-get-display profile 'location location))
1105
1106;;;###autoload
1107(defun guix-package-from-file (file &optional profile)
1108 "Display Guix package that the code from FILE evaluates to.
1109If PROFILE is nil, use `guix-current-profile'.
1110Interactively with prefix, prompt for PROFILE."
1111 (interactive
1112 (list (read-file-name "File with package: ")
1113 (guix-ui-read-profile)))
1114 (guix-buffer-get-display-entries
1115 'info 'package
1116 (list (or profile guix-current-profile) 'from-file file)
1117 'add))
1118
1119;;;###autoload
1120(defun guix-search-by-regexp (regexp &optional params profile)
1121 "Search for Guix packages by REGEXP.
1122PARAMS are package parameters that should be searched.
1123If PARAMS are not specified, use `guix-package-search-params'.
1124
1125If PROFILE is nil, use `guix-current-profile'.
1126Interactively with prefix, prompt for PROFILE."
1127 (interactive
1128 (list (read-regexp "Regexp: " nil 'guix-package-search-history)
1129 nil (guix-ui-read-profile)))
1130 (guix-package-get-display profile 'regexp regexp
1131 (or params guix-package-search-params)))
1132
1133;;;###autoload
1134(defun guix-search-by-name (regexp &optional profile)
1135 "Search for Guix packages matching REGEXP in a package name.
1136If PROFILE is nil, use `guix-current-profile'.
1137Interactively with prefix, prompt for PROFILE."
1138 (interactive
1139 (list (read-string "Package name by regexp: "
1140 nil 'guix-package-search-history)
1141 (guix-ui-read-profile)))
1142 (guix-search-by-regexp regexp '(name) profile))
1143
1144;;;###autoload
1145(defun guix-installed-packages (&optional profile)
1146 "Display information about installed Guix packages.
1147If PROFILE is nil, use `guix-current-profile'.
1148Interactively with prefix, prompt for PROFILE."
1149 (interactive (list (guix-ui-read-profile)))
1150 (guix-package-get-display profile 'installed))
1151
1152;;;###autoload
1153(defun guix-installed-user-packages ()
1154 "Display information about Guix packages installed in a user profile."
1155 (interactive)
1156 (guix-installed-packages guix-user-profile))
1157
1158;;;###autoload
1159(defun guix-installed-system-packages ()
1160 "Display information about Guix packages installed in a system profile."
1161 (interactive)
1162 (guix-installed-packages
1163 (guix-packages-profile guix-system-profile nil t)))
1164
1165;;;###autoload
1166(defun guix-obsolete-packages (&optional profile)
1167 "Display information about obsolete Guix packages.
1168If PROFILE is nil, use `guix-current-profile'.
1169Interactively with prefix, prompt for PROFILE."
1170 (interactive (list (guix-ui-read-profile)))
1171 (guix-package-get-display profile 'obsolete))
1172
1173;;;###autoload
1174(defun guix-all-available-packages (&optional profile)
1175 "Display information about all available Guix packages.
1176If PROFILE is nil, use `guix-current-profile'.
1177Interactively with prefix, prompt for PROFILE."
1178 (interactive (list (guix-ui-read-profile)))
1179 (guix-package-get-display profile 'all-available))
1180
1181;;;###autoload
1182(defun guix-newest-available-packages (&optional profile)
1183 "Display information about the newest available Guix packages.
1184If PROFILE is nil, use `guix-current-profile'.
1185Interactively with prefix, prompt for PROFILE."
1186 (interactive (list (guix-ui-read-profile)))
1187 (guix-package-get-display profile 'newest-available))
1188
1189(provide 'guix-ui-package)
1190
1191;;; guix-ui-package.el ends here
diff --git a/emacs/guix-ui-system-generation.el b/emacs/guix-ui-system-generation.el
deleted file mode 100644
index 7f4d76d489f..00000000000
--- a/emacs/guix-ui-system-generation.el
+++ /dev/null
@@ -1,105 +0,0 @@
1;;; guix-ui-system-generation.el --- Interface for displaying system generations -*- lexical-binding: t -*-
2
3;; Copyright © 2016 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 an interface for displaying system generations
23;; in 'list' and 'info' buffers, and commands for working with them.
24
25;;; Code:
26
27(require 'cl-lib)
28(require 'guix-list)
29(require 'guix-ui)
30(require 'guix-ui-generation)
31(require 'guix-profiles)
32
33(guix-ui-define-entry-type system-generation)
34
35(defun guix-system-generation-get-display (search-type &rest search-values)
36 "Search for system generations and show results.
37See `guix-ui-get-entries' for the meaning of SEARCH-TYPE and
38SEARCH-VALUES."
39 (apply #'guix-list-get-display-entries
40 'system-generation
41 guix-system-profile
42 search-type search-values))
43
44
45;;; System generation 'info'
46
47(guix-ui-info-define-interface system-generation
48 :buffer-name "*Guix Generation Info*"
49 :format '((number format guix-generation-info-insert-number)
50 (label format (format))
51 (prev-number format (format))
52 (current format guix-generation-info-insert-current)
53 (path format (format guix-file))
54 (time format (time))
55 (root-device format (format))
56 (kernel format (format guix-file)))
57 :titles guix-generation-info-titles)
58
59
60;;; System generation 'list'
61
62;; FIXME It is better to make `guix-generation-list-shared-map' with
63;; common keys for both usual and system generations.
64(defvar guix-system-generation-list-mode-map
65 (copy-keymap guix-generation-list-mode-map)
66 "Keymap for `guix-system-generation-list-mode' buffers.")
67
68(guix-ui-list-define-interface system-generation
69 :buffer-name "*Guix Generation List*"
70 :format '((number nil 5 guix-list-sort-numerically-0 :right-align t)
71 (current guix-generation-list-get-current 10 t)
72 (label nil 40 t)
73 (time guix-list-get-time 20 t)
74 (path guix-list-get-file-name 30 t))
75 :titles guix-generation-list-titles
76 :sort-key '(number . t)
77 :marks '((delete . ?D)))
78
79
80;;; Interactive commands
81
82;;;###autoload
83(defun guix-system-generations ()
84 "Display information about system generations."
85 (interactive)
86 (guix-system-generation-get-display 'all))
87
88;;;###autoload
89(defun guix-last-system-generations (number)
90 "Display information about last NUMBER of system generations."
91 (interactive "nThe number of last generations: ")
92 (guix-system-generation-get-display 'last number))
93
94;;;###autoload
95(defun guix-system-generations-by-time (from to)
96 "Display information about system generations created between FROM and TO."
97 (interactive
98 (list (guix-read-date "Find generations (from): ")
99 (guix-read-date "Find generations (to): ")))
100 (guix-system-generation-get-display
101 'time (float-time from) (float-time to)))
102
103(provide 'guix-ui-system-generation)
104
105;;; guix-ui-system-generation.el ends here
diff --git a/emacs/guix-ui.el b/emacs/guix-ui.el
deleted file mode 100644
index 1b696314cdd..00000000000
--- a/emacs/guix-ui.el
+++ /dev/null
@@ -1,323 +0,0 @@
1;;; guix-ui.el --- Common code for Guix package management interface -*- lexical-binding: t -*-
2
3;; Copyright © 2014, 2015, 2016 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 general code for 'list'/'info' interfaces for
23;; packages and generations.
24
25;;; Code:
26
27(require 'cl-lib)
28(require 'guix-backend)
29(require 'guix-buffer)
30(require 'guix-guile)
31(require 'guix-utils)
32(require 'guix-messages)
33(require 'guix-profiles)
34
35(guix-define-groups ui
36 :group-doc "\
37Settings for 'ui' (Guix package management) buffers.
38This group includes settings for displaying packages, outputs and
39generations in 'list' and 'info' buffers.")
40
41(defvar guix-ui-map
42 (let ((map (make-sparse-keymap)))
43 (define-key map (kbd "M") 'guix-apply-manifest)
44 (define-key map (kbd "C-c C-z") 'guix-switch-to-repl)
45 map)
46 "Parent keymap for Guix package/generation buffers.")
47
48(guix-buffer-define-current-args-accessors
49 "guix-ui-current" "profile" "search-type" "search-values")
50
51(defun guix-ui-read-profile ()
52 "Return `guix-current-profile' or prompt for it.
53This function is intended for using in `interactive' forms."
54 (if current-prefix-arg
55 (guix-profile-prompt)
56 guix-current-profile))
57
58(defun guix-ui-get-entries (profile entry-type search-type search-values
59 &optional params)
60 "Receive ENTRY-TYPE entries for PROFILE.
61Call an appropriate scheme procedure and return a list of entries.
62
63ENTRY-TYPE should be one of the following symbols: `package',
64`output' or `generation'.
65
66SEARCH-TYPE may be one of the following symbols:
67
68- If ENTRY-TYPE is `package' or `output': `id', `name', `regexp',
69 `all-available', `newest-available', `installed', `obsolete',
70 `generation'.
71
72- If ENTRY-TYPE is `generation': `id', `last', `all', `time'.
73
74PARAMS is a list of parameters for receiving. If nil, get data
75with all available parameters."
76 (guix-eval-read
77 (guix-make-guile-expression
78 'entries
79 profile params entry-type search-type search-values)))
80
81(defun guix-ui-list-describe (ids)
82 "Describe 'ui' entries with IDS (list of identifiers)."
83 (guix-buffer-get-display-entries
84 'info (guix-buffer-current-entry-type)
85 (cl-list* (guix-ui-current-profile) 'id ids)
86 'add))
87
88
89;;; Buffers and auto updating
90
91(defcustom guix-ui-update-after-operation 'current
92 "Define what kind of data to update after executing an operation.
93
94After successful executing an operation in the Guix REPL (for
95example after installing a package), the data in Guix buffers
96will or will not be automatically updated depending on a value of
97this variable.
98
99If nil, update nothing (do not revert any buffer).
100If `current', update the buffer from which an operation was performed.
101If `all', update all Guix buffers (not recommended)."
102 :type '(choice (const :tag "Do nothing" nil)
103 (const :tag "Update operation buffer" current)
104 (const :tag "Update all Guix buffers" all))
105 :group 'guix-ui)
106
107(defcustom guix-ui-buffer-name-function
108 #'guix-ui-buffer-name-full
109 "Function used to define a name of a Guix buffer.
110The function is called with 2 arguments: BASE-NAME and PROFILE."
111 :type '(choice (function-item guix-ui-buffer-name-full)
112 (function-item guix-ui-buffer-name-short)
113 (function-item guix-ui-buffer-name-simple)
114 (function :tag "Other function"))
115 :group 'guix-ui)
116
117(defun guix-ui-buffer-name-simple (base-name &rest _)
118 "Return BASE-NAME."
119 base-name)
120
121(defun guix-ui-buffer-name-short (base-name profile)
122 "Return buffer name by appending BASE-NAME and PROFILE's base file name."
123 (guix-compose-buffer-name base-name
124 (file-name-base (directory-file-name profile))))
125
126(defun guix-ui-buffer-name-full (base-name profile)
127 "Return buffer name by appending BASE-NAME and PROFILE's full name."
128 (guix-compose-buffer-name base-name profile))
129
130(defun guix-ui-buffer-name (base-name profile)
131 "Return Guix buffer name based on BASE-NAME and profile.
132See `guix-ui-buffer-name-function' for details."
133 (funcall guix-ui-buffer-name-function
134 base-name profile))
135
136(defun guix-ui-buffer? (&optional buffer modes)
137 "Return non-nil if BUFFER mode is derived from any of the MODES.
138If BUFFER is nil, check current buffer.
139If MODES is nil, use `guix-list-mode' and `guix-info-mode'."
140 (with-current-buffer (or buffer (current-buffer))
141 (apply #'derived-mode-p
142 (or modes '(guix-list-mode guix-info-mode)))))
143
144(defun guix-ui-buffers (&optional modes)
145 "Return a list of all buffers with major modes derived from MODES.
146If MODES is nil, return list of all Guix 'list' and 'info' buffers."
147 (cl-remove-if-not (lambda (buf)
148 (guix-ui-buffer? buf modes))
149 (buffer-list)))
150
151(defun guix-ui-update-buffer (buffer)
152 "Update data in a 'list' or 'info' BUFFER."
153 (with-current-buffer buffer
154 (guix-buffer-revert nil t)))
155
156(defun guix-ui-update-buffers-after-operation ()
157 "Update buffers after Guix operation if needed.
158See `guix-ui-update-after-operation' for details."
159 (let ((to-update
160 (and guix-operation-buffer
161 (cl-case guix-ui-update-after-operation
162 (current (and (buffer-live-p guix-operation-buffer)
163 (guix-ui-buffer? guix-operation-buffer)
164 (list guix-operation-buffer)))
165 (all (guix-ui-buffers))))))
166 (setq guix-operation-buffer nil)
167 (mapc #'guix-ui-update-buffer to-update)))
168
169(add-hook 'guix-after-repl-operation-hook
170 'guix-ui-update-buffers-after-operation)
171
172
173;;; Interface definers
174
175(defmacro guix-ui-define-entry-type (entry-type &rest args)
176 "Define general code for ENTRY-TYPE.
177Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
178
179The rest keyword arguments are passed to
180`guix-define-entry-type' macro."
181 (declare (indent 1))
182 `(guix-define-entry-type ,entry-type
183 :parent-group guix-ui
184 :parent-faces-group guix-ui-faces
185 ,@args))
186
187(defmacro guix-ui-define-interface (buffer-type entry-type &rest args)
188 "Define BUFFER-TYPE interface for displaying ENTRY-TYPE entries.
189Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
190In the following description TYPE means ENTRY-TYPE-BUFFER-TYPE.
191
192Required keywords:
193
194 - `:buffer-name' - base part of a buffer name. It is used in a
195 generated `guix-TYPE-buffer-name' function; see
196 `guix-ui-buffer-name' for details.
197
198Optional keywords:
199
200 - `:required' - default value of the generated
201 `guix-TYPE-required-params' variable.
202
203The rest keyword arguments are passed to
204`guix-BUFFER-TYPE-define-interface' macro.
205
206Along with the mentioned definitions, this macro also defines:
207
208 - `guix-TYPE-mode-map' - keymap based on `guix-ui-map' and
209 `guix-BUFFER-TYPE-mode-map'.
210
211 - `guix-TYPE-get-entries' - a wrapper around `guix-ui-get-entries'.
212
213 - `guix-TYPE-message' - a wrapper around `guix-result-message'."
214 (declare (indent 2))
215 (let* ((entry-type-str (symbol-name entry-type))
216 (buffer-type-str (symbol-name buffer-type))
217 (prefix (concat "guix-" entry-type-str "-"
218 buffer-type-str))
219 (mode-str (concat prefix "-mode"))
220 (mode-map (intern (concat mode-str "-map")))
221 (parent-map (intern (format "guix-%s-mode-map"
222 buffer-type-str)))
223 (required-var (intern (concat prefix "-required-params")))
224 (buffer-name-fun (intern (concat prefix "-buffer-name")))
225 (get-fun (intern (concat prefix "-get-entries")))
226 (message-fun (intern (concat prefix "-message")))
227 (displayed-fun (intern (format "guix-%s-displayed-params"
228 buffer-type-str)))
229 (definer (intern (format "guix-%s-define-interface"
230 buffer-type-str))))
231 (guix-keyword-args-let args
232 ((buffer-name-val :buffer-name)
233 (required-val :required ''(id)))
234 `(progn
235 (defvar ,mode-map
236 (let ((map (make-sparse-keymap)))
237 (set-keymap-parent
238 map (make-composed-keymap ,parent-map guix-ui-map))
239 map)
240 ,(format "Keymap for `%s' buffers." mode-str))
241
242 (defvar ,required-var ,required-val
243 ,(format "\
244List of the required '%s' parameters.
245These parameters are received by `%S'
246along with the displayed parameters.
247
248Do not remove `id' from this list as it is required for
249identifying an entry."
250 entry-type-str get-fun))
251
252 (defun ,buffer-name-fun (profile &rest _)
253 ,(format "\
254Return a name of '%s' buffer for displaying '%s' entries.
255See `guix-ui-buffer-name' for details."
256 buffer-type-str entry-type-str)
257 (guix-ui-buffer-name ,buffer-name-val profile))
258
259 (defun ,get-fun (profile search-type &rest search-values)
260 ,(format "\
261Receive '%s' entries for displaying them in '%s' buffer.
262See `guix-ui-get-entries' for details."
263 entry-type-str buffer-type-str)
264 (guix-ui-get-entries
265 profile ',entry-type search-type search-values
266 (cl-union ,required-var
267 (,displayed-fun ',entry-type))))
268
269 (defun ,message-fun (entries profile search-type
270 &rest search-values)
271 ,(format "\
272Display a message after showing '%s' entries."
273 entry-type-str)
274 (guix-result-message
275 profile entries ',entry-type search-type search-values))
276
277 (,definer ,entry-type
278 :get-entries-function ',get-fun
279 :message-function ',message-fun
280 :buffer-name ',buffer-name-fun
281 ,@%foreign-args)))))
282
283(defmacro guix-ui-info-define-interface (entry-type &rest args)
284 "Define 'info' interface for displaying ENTRY-TYPE entries.
285See `guix-ui-define-interface'."
286 (declare (indent 1))
287 `(guix-ui-define-interface info ,entry-type
288 ,@args))
289
290(defmacro guix-ui-list-define-interface (entry-type &rest args)
291 "Define 'list' interface for displaying ENTRY-TYPE entries.
292Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
293
294Optional keywords:
295
296 - `:describe-function' - default value of the generated
297 `guix-ENTRY-TYPE-list-describe-function' variable (if not
298 specified, use `guix-ui-list-describe').
299
300The rest keyword arguments are passed to
301`guix-ui-define-interface' macro."
302 (declare (indent 1))
303 (guix-keyword-args-let args
304 ((describe-val :describe-function))
305 `(guix-ui-define-interface list ,entry-type
306 :describe-function ,(or describe-val ''guix-ui-list-describe)
307 ,@args)))
308
309
310(defvar guix-ui-font-lock-keywords
311 (eval-when-compile
312 `((,(rx "(" (group (or "guix-ui-define-entry-type"
313 "guix-ui-define-interface"
314 "guix-ui-info-define-interface"
315 "guix-ui-list-define-interface"))
316 symbol-end)
317 . 1))))
318
319(font-lock-add-keywords 'emacs-lisp-mode guix-ui-font-lock-keywords)
320
321(provide 'guix-ui)
322
323;;; guix-ui.el ends here
diff --git a/emacs/guix-utils.el b/emacs/guix-utils.el
deleted file mode 100644
index 3e4ecc36ab4..00000000000
--- a/emacs/guix-utils.el
+++ /dev/null
@@ -1,609 +0,0 @@
1;;; guix-utils.el --- General utility functions -*- lexical-binding: t -*-
2
3;; Copyright © 2014, 2015, 2016 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 'font-lock-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(defmacro guix-with-indent (indent &rest body)
68 "Evaluate BODY and indent inserted text by INDENT number of spaces."
69 (declare (indent 1) (debug t))
70 (let ((region-beg-var (make-symbol "region-beg"))
71 (indent-var (make-symbol "indent")))
72 `(let ((,region-beg-var (point))
73 (,indent-var ,indent))
74 ,@body
75 (unless (zerop ,indent-var)
76 (indent-rigidly ,region-beg-var (point) ,indent-var)))))
77
78(defun guix-format-insert (val &optional face format)
79 "Convert VAL into a string and insert it at point.
80If FACE is non-nil, propertize VAL with FACE.
81If FORMAT is non-nil, format VAL with FORMAT."
82 (let ((str (guix-get-string val face)))
83 (insert (if format
84 (format format str)
85 str))))
86
87(cl-defun guix-mapinsert (function sequence separator &key indent column)
88 "Like `mapconcat' but for inserting text.
89Apply FUNCTION to each element of SEQUENCE, and insert SEPARATOR
90at point between each FUNCTION call.
91
92If INDENT is non-nil, it should be a number of spaces used to
93indent each line of the inserted text.
94
95If COLUMN is non-nil, it should be a column number which
96shouldn't be exceeded by the inserted text."
97 (pcase sequence
98 (`(,first . ,rest)
99 (let* ((indent (or indent 0))
100 (max-column (and column (- column indent))))
101 (guix-with-indent indent
102 (funcall function first)
103 (dolist (element rest)
104 (let ((before-sep-pos (and column (point))))
105 (insert separator)
106 (let ((after-sep-pos (and column (point))))
107 (funcall function element)
108 (when (and column
109 (> (current-column) max-column))
110 (save-excursion
111 (delete-region before-sep-pos after-sep-pos)
112 (goto-char before-sep-pos)
113 (insert "\n")))))))))))
114
115(defun guix-insert-button (label &optional type &rest properties)
116 "Make button of TYPE with LABEL and insert it at point.
117See `insert-text-button' for the meaning of PROPERTIES."
118 (if (null label)
119 (guix-format-insert nil)
120 (apply #'insert-text-button label
121 :type (or type 'button)
122 properties)))
123
124(defun guix-buttonize (value button-type separator &rest properties)
125 "Make BUTTON-TYPE button(s) from VALUE.
126Return a string with button(s).
127
128VALUE should be a string or a list of strings. If it is a list
129of strings, buttons are separated with SEPARATOR string.
130
131PROPERTIES are passed to `guix-insert-button'."
132 (with-temp-buffer
133 (let ((labels (if (listp value) value (list value))))
134 (guix-mapinsert (lambda (label)
135 (apply #'guix-insert-button
136 label button-type properties))
137 labels
138 separator))
139 (buffer-substring (point-min) (point-max))))
140
141(defun guix-button-type? (symbol)
142 "Return non-nil, if SYMBOL is a button type."
143 (and symbol
144 (get symbol 'button-category-symbol)))
145
146(defun guix-split-insert (val &optional face col separator)
147 "Convert VAL into a string, split it and insert at point.
148
149If FACE is non-nil, propertize returned string with this FACE.
150
151If COL is non-nil and result string is a one-line string longer
152than COL, split it into several short lines.
153
154Separate inserted lines with SEPARATOR."
155 (if (null val)
156 (guix-format-insert nil)
157 (let ((strings (guix-split-string (guix-get-string val) col)))
158 (guix-mapinsert (lambda (str) (guix-format-insert str face))
159 strings
160 (or separator "")))))
161
162(defun guix-split-string (str &optional col)
163 "Split string STR by lines and return list of result strings.
164If COL is non-nil, fill STR to this column."
165 (let ((str (if col
166 (guix-get-filled-string str col)
167 str)))
168 (split-string str "\n *" t)))
169
170(defun guix-get-filled-string (str col)
171 "Return string by filling STR to column COL."
172 (with-temp-buffer
173 (insert str)
174 (let ((fill-column col))
175 (fill-region (point-min) (point-max)))
176 (buffer-string)))
177
178(defun guix-concat-strings (strings separator &optional location)
179 "Return new string by concatenating STRINGS with SEPARATOR.
180If LOCATION is a symbol `head', add another SEPARATOR to the
181beginning of the returned string; if `tail' - add SEPARATOR to
182the end of the string; if nil, do not add SEPARATOR; otherwise
183add both to the end and to the beginning."
184 (let ((str (mapconcat #'identity strings separator)))
185 (cond ((null location)
186 str)
187 ((eq location 'head)
188 (concat separator str))
189 ((eq location 'tail)
190 (concat str separator))
191 (t
192 (concat separator str separator)))))
193
194(defun guix-hexify (value)
195 "Convert VALUE to string and hexify it."
196 (url-hexify-string (guix-get-string value)))
197
198(defun guix-number->bool (number)
199 "Convert NUMBER to boolean value.
200Return nil, if NUMBER is 0; return t otherwise."
201 (not (zerop number)))
202
203(defun guix-shell-quote-argument (argument)
204 "Quote shell command ARGUMENT.
205This function is similar to `shell-quote-argument', but less strict."
206 (if (equal argument "")
207 "''"
208 (replace-regexp-in-string
209 "\n" "'\n'"
210 (replace-regexp-in-string
211 (rx (not (any alnum "-=,./\n"))) "\\\\\\&" argument))))
212
213(defun guix-symbol-title (symbol)
214 "Return SYMBOL's name, a string.
215This is like `symbol-name', but fancier."
216 (if (eq symbol 'id)
217 "ID"
218 (let ((str (replace-regexp-in-string "-" " " (symbol-name symbol))))
219 (concat (capitalize (substring str 0 1))
220 (substring str 1)))))
221
222(defun guix-command-symbol (&optional args)
223 "Return symbol by concatenating 'guix' and ARGS (strings)."
224 (intern (guix-concat-strings (cons "guix" args) "-")))
225
226(defun guix-command-string (&optional args)
227 "Return 'guix ARGS ...' string with quoted shell arguments."
228 (let ((args (mapcar #'guix-shell-quote-argument args)))
229 (guix-concat-strings (cons "guix" args) " ")))
230
231(defun guix-copy-as-kill (string &optional no-message?)
232 "Put STRING into `kill-ring'.
233If NO-MESSAGE? is non-nil, do not display a message about it."
234 (kill-new string)
235 (unless no-message?
236 (message "'%s' has been added to kill ring." string)))
237
238(defun guix-copy-command-as-kill (args &optional no-message?)
239 "Put 'guix ARGS ...' string into `kill-ring'.
240See also `guix-copy-as-kill'."
241 (guix-copy-as-kill (guix-command-string args) no-message?))
242
243(defun guix-compose-buffer-name (base-name postfix)
244 "Return buffer name by appending BASE-NAME and POSTFIX.
245
246In a simple case the result is:
247
248 BASE-NAME: POSTFIX
249
250If BASE-NAME is wrapped by '*', then the result is:
251
252 *BASE-NAME: POSTFIX*"
253 (let ((re (rx string-start
254 (group (? "*"))
255 (group (*? any))
256 (group (? "*"))
257 string-end)))
258 (or (string-match re base-name)
259 (error "Unexpected error in defining buffer name"))
260 (let ((first* (match-string 1 base-name))
261 (name-body (match-string 2 base-name))
262 (last* (match-string 3 base-name)))
263 ;; Handle the case when buffer name is wrapped by '*'.
264 (if (and (string= "*" first*)
265 (string= "*" last*))
266 (concat "*" name-body ": " postfix "*")
267 (concat base-name ": " postfix)))))
268
269(defun guix-completing-read (prompt table &optional predicate
270 require-match initial-input
271 hist def inherit-input-method)
272 "Same as `completing-read' but return nil instead of an empty string."
273 (let ((res (completing-read prompt table predicate
274 require-match initial-input
275 hist def inherit-input-method)))
276 (unless (string= "" res) res)))
277
278(defun guix-completing-read-multiple (prompt table &optional predicate
279 require-match initial-input
280 hist def inherit-input-method)
281 "Same as `completing-read-multiple' but remove duplicates in result."
282 (cl-remove-duplicates
283 (completing-read-multiple prompt table predicate
284 require-match initial-input
285 hist def inherit-input-method)
286 :test #'string=))
287
288(declare-function org-read-date "org" t)
289
290(defun guix-read-date (prompt)
291 "Prompt for a date or time using `org-read-date'.
292Return time value."
293 (require 'org)
294 (org-read-date nil t nil prompt))
295
296(defun guix-read-file-name (prompt &optional dir default-filename
297 mustmatch initial predicate)
298 "Read file name.
299This function is similar to `read-file-name' except it also
300expands the file name."
301 (expand-file-name (read-file-name prompt dir default-filename
302 mustmatch initial predicate)))
303
304(defcustom guix-find-file-function #'find-file
305 "Function used to find a file.
306The function is called by `guix-find-file' with a file name as a
307single argument."
308 :type '(choice (function-item find-file)
309 (function-item org-open-file)
310 (function :tag "Other function"))
311 :group 'guix)
312
313(defun guix-find-file (file)
314 "Find FILE if it exists."
315 (if (file-exists-p file)
316 (funcall guix-find-file-function file)
317 (message "File '%s' does not exist." file)))
318
319(defvar url-handler-regexp)
320
321(defun guix-find-file-or-url (file-or-url)
322 "Find FILE-OR-URL."
323 (require 'url-handlers)
324 (let ((file-name-handler-alist
325 (cons (cons url-handler-regexp 'url-file-handler)
326 file-name-handler-alist)))
327 (find-file file-or-url)))
328
329(defmacro guix-while-search (regexp &rest body)
330 "Evaluate BODY after each search for REGEXP in the current buffer."
331 (declare (indent 1) (debug t))
332 `(save-excursion
333 (goto-char (point-min))
334 (while (re-search-forward ,regexp nil t)
335 ,@body)))
336
337(defmacro guix-while-null (&rest body)
338 "Evaluate BODY until its result becomes non-nil."
339 (declare (indent 0) (debug t))
340 (let ((result-var (make-symbol "result")))
341 `(let (,result-var)
342 (while (null ,result-var)
343 (setq ,result-var ,@body))
344 ,result-var)))
345
346(defun guix-modify (object modifiers)
347 "Apply MODIFIERS to OBJECT.
348OBJECT is passed as an argument to the first function from
349MODIFIERS list, the returned result is passed to the second
350function from the list and so on. Return result of the last
351modifier call."
352 (if (null modifiers)
353 object
354 (guix-modify (funcall (car modifiers) object)
355 (cdr modifiers))))
356
357(defmacro guix-keyword-args-let (args varlist &rest body)
358 "Parse ARGS, bind variables from VARLIST and eval BODY.
359
360Find keyword values in ARGS, bind them to variables according to
361VARLIST, then evaluate BODY.
362
363ARGS is a keyword/value property list.
364
365Each element of VARLIST has a form:
366
367 (SYMBOL KEYWORD [DEFAULT-VALUE])
368
369SYMBOL is a varible name. KEYWORD is a symbol that will be
370searched in ARGS for an according value. If the value of KEYWORD
371does not exist, bind SYMBOL to DEFAULT-VALUE or nil.
372
373The rest arguments (that present in ARGS but not in VARLIST) will
374be bound to `%foreign-args' variable.
375
376Example:
377
378 (guix-keyword-args-let '(:two 8 :great ! :guix is)
379 ((one :one 1)
380 (two :two 2)
381 (foo :smth))
382 (list one two foo %foreign-args))
383
384 => (1 8 nil (:guix is :great !))"
385 (declare (indent 2))
386 (let ((args-var (make-symbol "args")))
387 `(let (,@(mapcar (lambda (spec)
388 (pcase-let ((`(,name ,_ ,val) spec))
389 (list name val)))
390 varlist)
391 (,args-var ,args)
392 %foreign-args)
393 (while ,args-var
394 (pcase ,args-var
395 (`(,key ,val . ,rest-args)
396 (cl-case key
397 ,@(mapcar (lambda (spec)
398 (pcase-let ((`(,name ,key ,_) spec))
399 `(,key (setq ,name val))))
400 varlist)
401 (t (setq %foreign-args
402 (cl-list* key val %foreign-args))))
403 (setq ,args-var rest-args))))
404 ,@body)))
405
406
407;;; Alist procedures
408
409(defmacro guix-define-alist-accessor (name assoc-fun)
410 "Define NAME function to access alist values using ASSOC-FUN."
411 `(defun ,name (alist &rest keys)
412 ,(format "Return value from ALIST by KEYS using `%s'.
413ALIST is alist of alists of alists ... which can be consecutively
414accessed with KEYS."
415 assoc-fun)
416 (if (or (null alist) (null keys))
417 alist
418 (apply #',name
419 (cdr (,assoc-fun (car keys) alist))
420 (cdr keys)))))
421
422(guix-define-alist-accessor guix-assq-value assq)
423(guix-define-alist-accessor guix-assoc-value assoc)
424
425(defun guix-alist-put (value alist &rest keys)
426 "Put (add or replace if exists) VALUE to ALIST using KEYS.
427Return the new alist.
428
429ALIST is alist of alists of alists ... which can be consecutively
430accessed with KEYS.
431
432Example:
433
434 (guix-alist-put
435 'foo
436 '((one (a . 1) (b . 2))
437 (two (m . 7) (n . 8)))
438 'one 'b)
439
440 => ((one (a . 1) (b . foo))
441 (two (m . 7) (n . 8)))"
442 (or keys (error "Keys should be specified"))
443 (guix-alist-put-1 value alist keys))
444
445(defun guix-alist-put-1 (value alist keys)
446 "Subroutine of `guix-alist-put'."
447 (cond
448 ((null keys)
449 value)
450 ((null alist)
451 (list (cons (car keys)
452 (guix-alist-put-1 value nil (cdr keys)))))
453 ((eq (car keys) (caar alist))
454 (cons (cons (car keys)
455 (guix-alist-put-1 value (cdar alist) (cdr keys)))
456 (cdr alist)))
457 (t
458 (cons (car alist)
459 (guix-alist-put-1 value (cdr alist) keys)))))
460
461(defun guix-alist-put! (value variable &rest keys)
462 "Modify alist VARIABLE (symbol) by putting VALUE using KEYS.
463See `guix-alist-put' for details."
464 (set variable
465 (apply #'guix-alist-put value (symbol-value variable) keys)))
466
467
468;;; Diff
469
470(defvar guix-diff-switches "-u"
471 "A string or list of strings specifying switches to be passed to diff.")
472
473(defun guix-diff (old new &optional switches no-async)
474 "Same as `diff', but use `guix-diff-switches' as default."
475 (diff old new (or switches guix-diff-switches) no-async))
476
477
478;;; Completing readers definers
479
480(defmacro guix-define-reader (name read-fun completions prompt)
481 "Define NAME function to read from minibuffer.
482READ-FUN may be `completing-read', `completing-read-multiple' or
483another function with the same arguments."
484 `(defun ,name (&optional prompt initial-contents)
485 (,read-fun ,(if prompt
486 `(or prompt ,prompt)
487 'prompt)
488 ,completions nil nil initial-contents)))
489
490(defmacro guix-define-readers (&rest args)
491 "Define reader functions.
492
493ARGS should have a form [KEYWORD VALUE] ... The following
494keywords are available:
495
496 - `completions-var' - variable used to get completions.
497
498 - `completions-getter' - function used to get completions.
499
500 - `single-reader', `single-prompt' - name of a function to read
501 a single value, and a prompt for it.
502
503 - `multiple-reader', `multiple-prompt' - name of a function to
504 read multiple values, and a prompt for it.
505
506 - `multiple-separator' - if specified, another
507 `<multiple-reader-name>-string' function returning a string
508 of multiple values separated the specified separator will be
509 defined."
510 (guix-keyword-args-let args
511 ((completions-var :completions-var)
512 (completions-getter :completions-getter)
513 (single-reader :single-reader)
514 (single-prompt :single-prompt)
515 (multiple-reader :multiple-reader)
516 (multiple-prompt :multiple-prompt)
517 (multiple-separator :multiple-separator))
518 (let ((completions
519 (cond ((and completions-var completions-getter)
520 `(or ,completions-var
521 (setq ,completions-var
522 (funcall ',completions-getter))))
523 (completions-var
524 completions-var)
525 (completions-getter
526 `(funcall ',completions-getter)))))
527 `(progn
528 ,(when (and completions-var
529 (not (boundp completions-var)))
530 `(defvar ,completions-var nil))
531
532 ,(when single-reader
533 `(guix-define-reader ,single-reader guix-completing-read
534 ,completions ,single-prompt))
535
536 ,(when multiple-reader
537 `(guix-define-reader ,multiple-reader completing-read-multiple
538 ,completions ,multiple-prompt))
539
540 ,(when (and multiple-reader multiple-separator)
541 (let ((name (intern (concat (symbol-name multiple-reader)
542 "-string"))))
543 `(defun ,name (&optional prompt initial-contents)
544 (guix-concat-strings
545 (,multiple-reader prompt initial-contents)
546 ,multiple-separator))))))))
547
548
549;;; Memoizing
550
551(defun guix-memoize (function)
552 "Return a memoized version of FUNCTION."
553 (let ((cache (make-hash-table :test 'equal)))
554 (lambda (&rest args)
555 (let ((result (gethash args cache 'not-found)))
556 (if (eq result 'not-found)
557 (let ((result (apply function args)))
558 (puthash args result cache)
559 result)
560 result)))))
561
562(defmacro guix-memoized-defun (name arglist docstring &rest body)
563 "Define a memoized function NAME.
564See `defun' for the meaning of arguments."
565 (declare (doc-string 3) (indent 2))
566 `(defalias ',name
567 (guix-memoize (lambda ,arglist ,@body))
568 ;; Add '(name args ...)' string with real arglist to the docstring,
569 ;; because *Help* will display '(name &rest ARGS)' for a defined
570 ;; function (since `guix-memoize' returns a lambda with '(&rest
571 ;; args)').
572 ,(format "(%S %s)\n\n%s"
573 name
574 (mapconcat #'symbol-name arglist " ")
575 docstring)))
576
577(defmacro guix-memoized-defalias (symbol definition &optional docstring)
578 "Set SYMBOL's function definition to memoized version of DEFINITION."
579 (declare (doc-string 3) (indent 1))
580 `(defalias ',symbol
581 (guix-memoize #',definition)
582 ,(or docstring
583 (format "Memoized version of `%S'." definition))))
584
585
586(defvar guix-utils-font-lock-keywords
587 (eval-when-compile
588 `((,(rx "(" (group (or "guix-define-reader"
589 "guix-define-readers"
590 "guix-keyword-args-let"
591 "guix-while-null"
592 "guix-while-search"
593 "guix-with-indent"))
594 symbol-end)
595 . 1)
596 (,(rx "("
597 (group "guix-memoized-" (or "defun" "defalias"))
598 symbol-end
599 (zero-or-more blank)
600 (zero-or-one
601 (group (one-or-more (or (syntax word) (syntax symbol))))))
602 (1 font-lock-keyword-face)
603 (2 font-lock-function-name-face nil t)))))
604
605(font-lock-add-keywords 'emacs-lisp-mode guix-utils-font-lock-keywords)
606
607(provide 'guix-utils)
608
609;;; guix-utils.el ends here
diff --git a/emacs/local.mk b/emacs/local.mk
deleted file mode 100644
index 959ec2dd34d..00000000000
--- a/emacs/local.mk
+++ /dev/null
@@ -1,77 +0,0 @@
1# GNU Guix --- Functional package management for GNU
2# Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com>
3# Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
4#
5# This file is part of GNU Guix.
6#
7# GNU Guix is free software; you can redistribute it and/or modify it
8# under the terms of the GNU General Public License as published by
9# the Free Software Foundation; either version 3 of the License, or (at
10# your option) any later version.
11#
12# GNU Guix is distributed in the hope that it will be useful, but
13# 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 GNU Guix. If not, see <http://www.gnu.org/licenses/>.
19
20AUTOLOADS = %D%/guix-autoloads.el
21
22ELFILES = \
23 %D%/guix-about.el \
24 %D%/guix-backend.el \
25 %D%/guix-base.el \
26 %D%/guix-build-log.el \
27 %D%/guix-buffer.el \
28 %D%/guix-command.el \
29 %D%/guix-devel.el \
30 %D%/guix-emacs.el \
31 %D%/guix-entry.el \
32 %D%/guix-external.el \
33 %D%/guix-geiser.el \
34 %D%/guix-guile.el \
35 %D%/guix-help-vars.el \
36 %D%/guix-history.el \
37 %D%/guix-hydra.el \
38 %D%/guix-hydra-build.el \
39 %D%/guix-hydra-jobset.el \
40 %D%/guix-info.el \
41 %D%/guix-init.el \
42 %D%/guix-license.el \
43 %D%/guix-list.el \
44 %D%/guix-location.el \
45 %D%/guix-messages.el \
46 %D%/guix-pcomplete.el \
47 %D%/guix-popup.el \
48 %D%/guix-prettify.el \
49 %D%/guix-profiles.el \
50 %D%/guix-read.el \
51 %D%/guix-ui.el \
52 %D%/guix-ui-license.el \
53 %D%/guix-ui-location.el \
54 %D%/guix-ui-package.el \
55 %D%/guix-ui-generation.el \
56 %D%/guix-ui-system-generation.el \
57 %D%/guix-utils.el
58
59if HAVE_EMACS
60
61dist_lisp_DATA = $(ELFILES)
62
63nodist_lisp_DATA = \
64 %D%/guix-config.el \
65 $(AUTOLOADS)
66
67$(AUTOLOADS): $(ELFILES)
68 $(AM_V_EMACS)$(EMACS) --batch --eval \
69 "(let ((backup-inhibited t) \
70 (generated-autoload-file \
71 (expand-file-name \"$(AUTOLOADS)\" \"$(builddir)\"))) \
72 (update-directory-autoloads \
73 (expand-file-name \"emacs\" \"$(srcdir)\")))"
74
75CLEANFILES += $(AUTOLOADS)
76
77endif HAVE_EMACS
diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-management.scm
index 732dbc2ce37..1b9191cbcbf 100644
--- a/gnu/packages/package-management.scm
+++ b/gnu/packages/package-management.scm
@@ -44,7 +44,6 @@
44 #:use-module (gnu packages curl) 44 #:use-module (gnu packages curl)
45 #:use-module (gnu packages web) 45 #:use-module (gnu packages web)
46 #:use-module (gnu packages man) 46 #:use-module (gnu packages man)
47 #:use-module (gnu packages emacs)
48 #:use-module (gnu packages bdw-gc) 47 #:use-module (gnu packages bdw-gc)
49 #:use-module (gnu packages python) 48 #:use-module (gnu packages python)
50 #:use-module (gnu packages popt) 49 #:use-module (gnu packages popt)
@@ -162,7 +161,6 @@
162 161
163 #t)))))) 162 #t))))))
164 (native-inputs `(("pkg-config" ,pkg-config) 163 (native-inputs `(("pkg-config" ,pkg-config)
165 ("emacs" ,emacs-minimal) ;for guix.el
166 164
167 ;; XXX: Keep the development inputs here even though 165 ;; XXX: Keep the development inputs here even though
168 ;; they're unnecessary, just so that 'guix environment 166 ;; they're unnecessary, just so that 'guix environment
@@ -206,9 +204,7 @@
206 (propagated-inputs 204 (propagated-inputs
207 `(("gnutls" ,gnutls) ;for 'guix download' & co. 205 `(("gnutls" ,gnutls) ;for 'guix download' & co.
208 ("guile-json" ,guile-json) 206 ("guile-json" ,guile-json)
209 ("guile-ssh" ,guile-ssh) 207 ("guile-ssh" ,guile-ssh)))
210 ("geiser" ,geiser) ;for guix.el
211 ("emacs-magit-popup" ,emacs-magit-popup))) ;for "M-x guix" command
212 208
213 (home-page "http://www.gnu.org/software/guix") 209 (home-page "http://www.gnu.org/software/guix")
214 (synopsis "Functional package manager for installed software packages and versions") 210 (synopsis "Functional package manager for installed software packages and versions")