diff options
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 | ||
| 468 | dist_emacsui_DATA = emacs/guix-main.scm | ||
| 469 | nodist_emacsui_DATA = emacs/guix-helper.scm | ||
| 470 | include emacs/local.mk | ||
| 471 | |||
| 472 | # The self-contained tarball. | 468 | # The self-contained tarball. |
| 473 | guix-binary.%.tar.xz: | 469 | guix-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)) | |||
| 548 | AM_V_DOT_ = $(AM_V_DOT_$(AM_DEFAULT_VERBOSITY)) | 544 | AM_V_DOT_ = $(AM_V_DOT_$(AM_DEFAULT_VERBOSITY)) |
| 549 | AM_V_DOT_0 = @echo " DOT " $@; | 545 | AM_V_DOT_0 = @echo " DOT " $@; |
| 550 | 546 | ||
| 551 | AM_V_EMACS = $(AM_V_EMACS_$(V)) | ||
| 552 | AM_V_EMACS_ = $(AM_V_EMACS_$(AM_DEFAULT_VERBOSITY)) | ||
| 553 | AM_V_EMACS_0 = @echo " EMACS " $@; | ||
| 554 | |||
| 555 | AM_V_HELP2MAN = $(AM_V_HELP2MAN_$(V)) | 547 | AM_V_HELP2MAN = $(AM_V_HELP2MAN_$(V)) |
| 556 | AM_V_HELP2MAN_ = $(AM_V_HELP2MAN_$(AM_DEFAULT_VERBOSITY)) | 548 | AM_V_HELP2MAN_ = $(AM_V_HELP2MAN_$(AM_DEFAULT_VERBOSITY)) |
| 557 | AM_V_HELP2MAN_0 = @echo " HELP2MAN" $@; | 549 | AM_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]) | |||
| 237 | AC_CONFIG_FILES([pre-inst-env:build-aux/pre-inst-env.in], | 237 | AC_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 | ||
| 240 | dnl Emacs interface. | ||
| 241 | AC_PATH_PROG([DOT_USER_PROGRAM], [dot], [dot]) | ||
| 242 | AM_PATH_LISPDIR | ||
| 243 | AM_CONDITIONAL([HAVE_EMACS], [test "x$EMACS" != "xno"]) | ||
| 244 | |||
| 245 | emacsuidir="${guilemoduledir}/guix/emacs" | ||
| 246 | AC_SUBST([emacsuidir]) | ||
| 247 | AC_CONFIG_FILES([emacs/guix-config.el | ||
| 248 | emacs/guix-helper.scm]) | ||
| 249 | |||
| 250 | AC_OUTPUT | 240 | AC_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 | |||
| 187 | s-expression or wrapping it, swallowing or rejecting the following | 187 | s-expression or wrapping it, swallowing or rejecting the following |
| 188 | s-expression, etc. | 188 | s-expression, etc. |
| 189 | 189 | ||
| 190 | GNU Guix also comes with a minor mode that provides some additional | ||
| 191 | functionality 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 | ||
| 5 | GNU Guix comes with several useful modules (known as ``guix.el'') for | ||
| 6 | GNU@tie{}Emacs which are intended to make an Emacs user interaction with | ||
| 7 | Guix 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 | |||
| 26 | On the Guix System Distribution (@pxref{GNU Distribution}), ``guix.el'' | ||
| 27 | is ready to use, provided Guix is installed system-wide, which is the | ||
| 28 | case by default. So if that is what you're using, you can happily skip | ||
| 29 | this section and read about the fun stuff. | ||
| 30 | |||
| 31 | If you're not yet a happy user of GuixSD, a little bit of setup is needed. | ||
| 32 | To be able to use ``guix.el'', you need to install the following | ||
| 33 | packages: | ||
| 34 | |||
| 35 | @itemize | ||
| 36 | @item | ||
| 37 | @uref{http://www.gnu.org/software/emacs/, GNU Emacs}, version 24.3 or | ||
| 38 | later; | ||
| 39 | |||
| 40 | @item | ||
| 41 | @uref{http://nongnu.org/geiser/, Geiser}, version 0.3 or later: it is | ||
| 42 | used for interacting with the Guile process. | ||
| 43 | |||
| 44 | @item | ||
| 45 | @uref{https://github.com/magit/magit/, magit-popup library}. You | ||
| 46 | already have this library if you use Magit 2.1.0 or later. This library | ||
| 47 | is an optional dependency---it is required only for @kbd{M-x@tie{}guix} | ||
| 48 | command (@pxref{Emacs Popup Interface}). | ||
| 49 | |||
| 50 | @end itemize | ||
| 51 | |||
| 52 | When it is done, ``guix.el'' may be configured by requiring | ||
| 53 | @code{guix-autoloads} file. If you install Guix in your user profile, | ||
| 54 | this 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 | ||
| 57 | is no need to read further. | ||
| 58 | |||
| 59 | For the manual installation, you need to add the following code into | ||
| 60 | your 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 | |||
| 67 | So the only thing you need to figure out is where the directory with | ||
| 68 | elisp files for Guix is placed. It depends on how you installed Guix: | ||
| 69 | |||
| 70 | @itemize | ||
| 71 | @item | ||
| 72 | If it was installed by a package manager of your distribution or by a | ||
| 73 | usual @code{./configure && make && make install} command sequence, then | ||
| 74 | elisp 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 | ||
| 77 | that if you don't update this installation periodically, you may get an | ||
| 78 | outdated Emacs code which does not work with the current Guile code of | ||
| 79 | Guix. | ||
| 80 | |||
| 81 | @item | ||
| 82 | If you used a binary installation method (@pxref{Binary Installation}), | ||
| 83 | then Guix is installed somewhere in the store, so the elisp files are | ||
| 84 | placed in @file{/gnu/store/@dots{}-guix-0.8.2/share/emacs/site-lisp/} or | ||
| 85 | alike. However it is not recommended to refer directly to a store | ||
| 86 | directory, as it may be garbage-collected one day. So a better choice | ||
| 87 | would be to install Guix using Guix itself with @command{guix package -i | ||
| 88 | guix}. | ||
| 89 | |||
| 90 | @item | ||
| 91 | If 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 | ||
| 94 | same 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 | |||
| 108 | Once ``guix.el'' has been successfully configured, you should be able to | ||
| 109 | use a visual interface for routine package management tasks, pretty much | ||
| 110 | like the @command{guix package} command (@pxref{Invoking guix package}). | ||
| 111 | Specifically, 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 | |||
| 131 | All commands for displaying packages and generations use the current | ||
| 132 | profile, which can be changed with | ||
| 133 | @kbd{M-x@tie{}guix-set-current-profile}. Alternatively, if you call any | ||
| 134 | of these commands with prefix argument (@kbd{C-u}), you will be prompted | ||
| 135 | for a profile just for that command. | ||
| 136 | |||
| 137 | Commands for displaying packages: | ||
| 138 | |||
| 139 | @table @kbd | ||
| 140 | |||
| 141 | @item M-x guix-all-available-packages | ||
| 142 | @itemx M-x guix-newest-available-packages | ||
| 143 | Display 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 | ||
| 148 | Display installed packages. As described above, @kbd{M-x | ||
| 149 | guix-installed-packages} uses an arbitrary profile that you can specify, | ||
| 150 | while the other commands display packages installed in 2 special | ||
| 151 | profiles: @file{~/.guix-profile} and @file{/run/current-system/profile} | ||
| 152 | (only on GuixSD). | ||
| 153 | |||
| 154 | @item M-x guix-obsolete-packages | ||
| 155 | Display obsolete packages (the packages that are installed in a profile | ||
| 156 | but cannot be found among available packages). | ||
| 157 | |||
| 158 | @item M-x guix-packages-by-name | ||
| 159 | Display package(s) with the specified name. | ||
| 160 | |||
| 161 | @item M-x guix-packages-by-license | ||
| 162 | Display package(s) with the specified license. | ||
| 163 | |||
| 164 | @item M-x guix-packages-by-location | ||
| 165 | Display package(s) located in the specified file. These files usually | ||
| 166 | have the following form: @file{gnu/packages/emacs.scm}, but don't type | ||
| 167 | them manually! Press @key{TAB} to complete the file name. | ||
| 168 | |||
| 169 | @item M-x guix-package-from-file | ||
| 170 | Display package that the code within the specified file evaluates to. | ||
| 171 | @xref{Invoking guix package, @code{--install-from-file}}, for an example | ||
| 172 | of what such a file may look like. | ||
| 173 | |||
| 174 | @item M-x guix-search-by-regexp | ||
| 175 | Search for packages by a specified regexp. By default ``name'', | ||
| 176 | ``synopsis'' and ``description'' of the packages will be searched. This | ||
| 177 | can be changed by modifying @code{guix-package-search-params} variable. | ||
| 178 | |||
| 179 | @item M-x guix-search-by-name | ||
| 180 | Search for packages with names matching a specified regexp. This | ||
| 181 | command is the same as @code{guix-search-by-regexp}, except only a | ||
| 182 | package ``name'' is searched. | ||
| 183 | |||
| 184 | @end table | ||
| 185 | |||
| 186 | By default, these commands display each output on a separate line. If | ||
| 187 | you prefer to see a list of packages---i.e., a list with a package per | ||
| 188 | line, use the following setting: | ||
| 189 | |||
| 190 | @example | ||
| 191 | (setq guix-package-list-type 'package) | ||
| 192 | @end example | ||
| 193 | |||
| 194 | Commands for displaying generations: | ||
| 195 | |||
| 196 | @table @kbd | ||
| 197 | |||
| 198 | @item M-x guix-generations | ||
| 199 | List all the generations. | ||
| 200 | |||
| 201 | @item M-x guix-last-generations | ||
| 202 | List the @var{N} last generations. You will be prompted for the number | ||
| 203 | of generations. | ||
| 204 | |||
| 205 | @item M-x guix-generations-by-time | ||
| 206 | List generations matching time period. You will be prompted for the | ||
| 207 | period using Org mode time prompt based on Emacs calendar (@pxref{The | ||
| 208 | date/time prompt,,, org, The Org Manual}). | ||
| 209 | |||
| 210 | @end table | ||
| 211 | |||
| 212 | Analogously 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 | |||
| 220 | You can also invoke the @command{guix pull} command (@pxref{Invoking | ||
| 221 | guix pull}) from Emacs using: | ||
| 222 | |||
| 223 | @table @kbd | ||
| 224 | @item M-x guix-pull | ||
| 225 | With @kbd{C-u}, make it verbose. | ||
| 226 | @end table | ||
| 227 | |||
| 228 | Once @command{guix pull} has succeeded, the Guix REPL is restarted. This | ||
| 229 | allows you to keep using the Emacs interface with the updated Guix. | ||
| 230 | |||
| 231 | |||
| 232 | @node Emacs General info | ||
| 233 | @subsection General information | ||
| 234 | |||
| 235 | The following keys are available for both ``list'' and ``info'' types of | ||
| 236 | buffers: | ||
| 237 | |||
| 238 | @table @kbd | ||
| 239 | @item l | ||
| 240 | @itemx r | ||
| 241 | Go backward/forward by the history of the displayed results (this | ||
| 242 | history is similar to the history of the Emacs @code{help-mode} or | ||
| 243 | @code{Info-mode}). | ||
| 244 | |||
| 245 | @item g | ||
| 246 | Revert current buffer: update information about the displayed | ||
| 247 | packages/generations and redisplay it. | ||
| 248 | |||
| 249 | @item R | ||
| 250 | Redisplay current buffer (without updating information). | ||
| 251 | |||
| 252 | @item M | ||
| 253 | Apply manifest to the current profile or to a specified profile, if | ||
| 254 | prefix argument is used. This has the same meaning as @code{--manifest} | ||
| 255 | option (@pxref{Invoking guix package}). | ||
| 256 | |||
| 257 | @item C-c C-z | ||
| 258 | @cindex REPL | ||
| 259 | @cindex read-eval-print loop | ||
| 260 | Go to the Guix REPL (@pxref{The REPL,,, geiser, Geiser User Manual}). | ||
| 261 | |||
| 262 | @item h | ||
| 263 | @itemx ? | ||
| 264 | Describe 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 | ||
| 269 | simply @kbd{M-x clone-buffer} them, and each buffer will have its own | ||
| 270 | history. | ||
| 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 | ||
| 274 | identifiers that live only during a guile session, so if the Guix REPL | ||
| 275 | was restarted, you may want to revert ``list'' buffer (by pressing | ||
| 276 | @kbd{g}). | ||
| 277 | |||
| 278 | @node Emacs List buffer | ||
| 279 | @subsection ``List'' buffer | ||
| 280 | |||
| 281 | An interface of a ``list'' buffer is similar to the interface provided | ||
| 282 | by ``package.el'' (@pxref{Package Menu,,, emacs, The GNU Emacs Manual}). | ||
| 283 | |||
| 284 | Default key bindings available for both ``package-list'' and | ||
| 285 | ``generation-list'' buffers: | ||
| 286 | |||
| 287 | @table @kbd | ||
| 288 | @item m | ||
| 289 | Mark the current entry (with prefix, mark all entries). | ||
| 290 | @item u | ||
| 291 | Unmark the current entry (with prefix, unmark all entries). | ||
| 292 | @item @key{DEL} | ||
| 293 | Unmark backward. | ||
| 294 | @item S | ||
| 295 | Sort entries by a specified column. | ||
| 296 | @end table | ||
| 297 | |||
| 298 | A ``package-list'' buffer additionally provides the following bindings: | ||
| 299 | |||
| 300 | @table @kbd | ||
| 301 | @item @key{RET} | ||
| 302 | Describe marked packages (display available information in a | ||
| 303 | ``package-info'' buffer). | ||
| 304 | @item i | ||
| 305 | Mark the current package for installation. | ||
| 306 | @item d | ||
| 307 | Mark the current package for deletion. | ||
| 308 | @item U | ||
| 309 | Mark the current package for upgrading. | ||
| 310 | @item ^ | ||
| 311 | Mark all obsolete packages for upgrading. | ||
| 312 | @item e | ||
| 313 | Edit the definition of the current package (go to its location). This is | ||
| 314 | similar to @command{guix edit} command (@pxref{Invoking guix edit}), but | ||
| 315 | for opening a package recipe in the current Emacs instance. | ||
| 316 | @item x | ||
| 317 | Execute actions on the marked packages. | ||
| 318 | @item B | ||
| 319 | Display latest builds of the current package (@pxref{Emacs Hydra}). | ||
| 320 | @end table | ||
| 321 | |||
| 322 | A ``generation-list'' buffer additionally provides the following | ||
| 323 | bindings: | ||
| 324 | |||
| 325 | @table @kbd | ||
| 326 | @item @key{RET} | ||
| 327 | List packages installed in the current generation. | ||
| 328 | @item i | ||
| 329 | Describe marked generations (display available information in a | ||
| 330 | ``generation-info'' buffer). | ||
| 331 | @item s | ||
| 332 | Switch profile to the current generation. | ||
| 333 | @item d | ||
| 334 | Mark the current generation for deletion (with prefix, mark all | ||
| 335 | generations). | ||
| 336 | @item x | ||
| 337 | Execute actions on the marked generations---i.e., delete generations. | ||
| 338 | @item e | ||
| 339 | Run Ediff (@pxref{Top,,, ediff, The Ediff Manual}) on package outputs | ||
| 340 | installed in the 2 marked generations. With prefix argument, run Ediff | ||
| 341 | on manifests of the marked generations. | ||
| 342 | @item D | ||
| 343 | @itemx = | ||
| 344 | Run Diff (@pxref{Diff Mode,,, emacs, The GNU Emacs Manual}) on package | ||
| 345 | outputs installed in the 2 marked generations. With prefix argument, | ||
| 346 | run Diff on manifests of the marked generations. | ||
| 347 | @item + | ||
| 348 | List package outputs added to the latest marked generation comparing | ||
| 349 | with another marked generation. | ||
| 350 | @item - | ||
| 351 | List package outputs removed from the latest marked generation comparing | ||
| 352 | with another marked generation. | ||
| 353 | @end table | ||
| 354 | |||
| 355 | @node Emacs Info buffer | ||
| 356 | @subsection ``Info'' buffer | ||
| 357 | |||
| 358 | The 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,,, | ||
| 363 | emacs, 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 | |||
| 387 | It is also possible to copy a button label (a link to an URL or a file) | ||
| 388 | by pressing @kbd{c} on a button. | ||
| 389 | |||
| 390 | |||
| 391 | @node Emacs Configuration | ||
| 392 | @subsection Configuration | ||
| 393 | |||
| 394 | There are many variables you can modify to change the appearance or | ||
| 395 | behavior of Emacs user interface. Some of these variables are described | ||
| 396 | in this section. Also you can use Custom Interface (@pxref{Easy | ||
| 397 | Customization,,, 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 | ||
| 412 | If you have some special needs for starting a Guile process, you may set | ||
| 413 | this 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 | ||
| 420 | If nil, has the same meaning as @code{--no-substitutes} option | ||
| 421 | (@pxref{Invoking guix build}). | ||
| 422 | |||
| 423 | @item guix-dry-run | ||
| 424 | If 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 | |||
| 432 | Default names of ``guix.el'' buffers (``*Guix@tie{}@dots{}*'') may be | ||
| 433 | changed 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 | |||
| 446 | By 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 | |||
| 450 | For example, if you want to display all types of results in a single | ||
| 451 | buffer (in such case you will probably use a history (@kbd{l}/@kbd{r}) | ||
| 452 | extensively), 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 | |||
| 468 | If 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 | ||
| 473 | Parent keymap with general keys for any buffer type. | ||
| 474 | |||
| 475 | @item guix-ui-map | ||
| 476 | Parent keymap with general keys for buffers used for Guix package | ||
| 477 | management (for packages, outputs and generations). | ||
| 478 | |||
| 479 | @item guix-list-mode-map | ||
| 480 | Parent keymap with general keys for ``list'' buffers. | ||
| 481 | |||
| 482 | @item guix-package-list-mode-map | ||
| 483 | Keymap with specific keys for ``package-list'' buffers. | ||
| 484 | |||
| 485 | @item guix-output-list-mode-map | ||
| 486 | Keymap with specific keys for ``output-list'' buffers. | ||
| 487 | |||
| 488 | @item guix-generation-list-mode-map | ||
| 489 | Keymap with specific keys for ``generation-list'' buffers. | ||
| 490 | |||
| 491 | @item guix-info-mode-map | ||
| 492 | Parent keymap with general keys for ``info'' buffers. | ||
| 493 | |||
| 494 | @item guix-package-info-mode-map | ||
| 495 | Keymap with specific keys for ``package-info'' buffers. | ||
| 496 | |||
| 497 | @item guix-output-info-mode-map | ||
| 498 | Keymap with specific keys for ``output-info'' buffers. | ||
| 499 | |||
| 500 | @item guix-generation-info-mode-map | ||
| 501 | Keymap with specific keys for ``generation-info'' buffers. | ||
| 502 | |||
| 503 | @item guix-info-button-map | ||
| 504 | Keymap with keys available when a point is placed on a button. | ||
| 505 | |||
| 506 | @end table | ||
| 507 | |||
| 508 | @node Emacs Appearance | ||
| 509 | @subsubsection Appearance | ||
| 510 | |||
| 511 | You can change almost any aspect of ``list'' / ``info'' buffers using | ||
| 512 | the 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 | ||
| 518 | Specify the columns, their names, what and how is displayed in ``list'' | ||
| 519 | buffers. | ||
| 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 | ||
| 529 | Various settings for ``info'' buffers. | ||
| 530 | |||
| 531 | @end table | ||
| 532 | |||
| 533 | |||
| 534 | @node Emacs Licenses | ||
| 535 | @section Licenses | ||
| 536 | |||
| 537 | If you want to browse the URL of a particular license, or to look at a | ||
| 538 | list of licenses, you may use the following commands: | ||
| 539 | |||
| 540 | @table @kbd | ||
| 541 | |||
| 542 | @item M-x guix-browse-license-url | ||
| 543 | Choose a license from a completion list to browse its URL using | ||
| 544 | @code{browse-url} function (@pxref{Browse-URL,,, emacs, The GNU Emacs | ||
| 545 | Manual}). | ||
| 546 | |||
| 547 | @item M-x guix-licenses | ||
| 548 | Display a list of available licenses. You can press @kbd{@key{RET}} | ||
| 549 | there to display packages with this license in the same way as @kbd{M-x | ||
| 550 | guix-packages-by-license} would do (@pxref{Emacs Commands}). | ||
| 551 | |||
| 552 | @item M-x guix-find-license-definition | ||
| 553 | Open @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 | |||
| 561 | As you know, package definitions are placed in Guile files, also known | ||
| 562 | as @dfn{package locations}. The following commands should help you not | ||
| 563 | get lost in these locations: | ||
| 564 | |||
| 565 | @table @kbd | ||
| 566 | |||
| 567 | @item M-x guix-locations | ||
| 568 | Display a list of package locations. You can press @key{RET} there to | ||
| 569 | display packages placed in the current location in the same way as | ||
| 570 | @kbd{M-x guix-packages-by-location} would do (@pxref{Emacs Commands}). | ||
| 571 | Note that when the point is on a location button, @key{RET} will open | ||
| 572 | this location file. | ||
| 573 | |||
| 574 | @item M-x guix-find-location | ||
| 575 | Open the given package definition source file (press @key{TAB} to choose | ||
| 576 | a location from a completion list). | ||
| 577 | |||
| 578 | @item M-x guix-edit | ||
| 579 | Find 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 | ||
| 582 | package name. | ||
| 583 | |||
| 584 | @end table | ||
| 585 | |||
| 586 | If you are contributing to Guix, you may find it useful for @kbd{M-x | ||
| 587 | guix-find-location} and @kbd{M-x guix-edit} to open locations from your | ||
| 588 | Git checkout. This can be done by setting @code{guix-directory} | ||
| 589 | variable. 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 | |||
| 598 | Also you can use @kbd{C-u} prefix argument to specify a directory just | ||
| 599 | for the current @kbd{M-x guix-find-location} or @kbd{M-x guix-edit} | ||
| 600 | command. | ||
| 601 | |||
| 602 | |||
| 603 | @node Emacs Popup Interface | ||
| 604 | @section Popup Interface | ||
| 605 | |||
| 606 | If you ever used Magit, you know what ``popup interface'' is | ||
| 607 | (@pxref{Top,,, magit-popup, Magit-Popup User Manual}). Even if you are | ||
| 608 | not acquainted with Magit, there should be no worries as it is very | ||
| 609 | intuitive. | ||
| 610 | |||
| 611 | So @kbd{M-x@tie{}guix} command provides a top-level popup interface for | ||
| 612 | all available guix commands. When you select an option, you'll be | ||
| 613 | prompted for a value in the minibuffer. Many values have completions, | ||
| 614 | so don't hesitate to press @key{TAB} key. Multiple values (for example, | ||
| 615 | packages or lint checkers) should be separated by commas. | ||
| 616 | |||
| 617 | After specifying all options and switches for a command, you may choose | ||
| 618 | one of the available actions. The following default actions are | ||
| 619 | available for all commands: | ||
| 620 | |||
| 621 | @itemize | ||
| 622 | |||
| 623 | @item | ||
| 624 | Run the command in the Guix REPL. It is faster than running | ||
| 625 | @code{guix@tie{}@dots{}} command directly in shell, as there is no | ||
| 626 | need to run another guile process and to load required modules there. | ||
| 627 | |||
| 628 | @item | ||
| 629 | Run the command in a shell buffer. You can set | ||
| 630 | @code{guix-run-in-shell-function} variable to fine tune the shell buffer | ||
| 631 | you want to use. | ||
| 632 | |||
| 633 | @item | ||
| 634 | Add the command line to the kill ring (@pxref{Kill Ring,,, emacs, The | ||
| 635 | GNU Emacs Manual}). | ||
| 636 | |||
| 637 | @end itemize | ||
| 638 | |||
| 639 | Several commands (@command{guix graph}, @command{guix system shepherd-graph} | ||
| 640 | and @command{guix system extension-graph}) also have a ``View graph'' | ||
| 641 | action, which allows you to view a generated graph using @command{dot} | ||
| 642 | command (specified by @code{guix-dot-program} variable). By default a | ||
| 643 | PNG file will be saved in @file{/tmp} directory and will be opened | ||
| 644 | directly in Emacs. This behavior may be changed with the following | ||
| 645 | variables: | ||
| 646 | |||
| 647 | @table @code | ||
| 648 | |||
| 649 | @item guix-find-file-function | ||
| 650 | Function used to open a generated graph. If you want to open a graph in | ||
| 651 | an external program, you can do it by modifying this variable---for | ||
| 652 | example, 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 | ||
| 661 | Command line arguments to run @command{dot} command. If you change an | ||
| 662 | output format (for example, into @code{-Tpdf}), you also need to change | ||
| 663 | the next variable. | ||
| 664 | |||
| 665 | @item guix-dot-file-name-function | ||
| 666 | Function used to define a name of the generated graph file. Default | ||
| 667 | name is @file{/tmp/guix-emacs-graph-XXXXXX.png}. | ||
| 668 | |||
| 669 | @end table | ||
| 670 | |||
| 671 | So, for example, if you want to generate and open a PDF file in your | ||
| 672 | Emacs, 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 | |||
| 686 | GNU@tie{}Guix also comes with ``guix-prettify.el''. It provides a minor | ||
| 687 | mode for abbreviating store file names by replacing hash sequences of | ||
| 688 | symbols with ``@dots{}'': | ||
| 689 | |||
| 690 | @example | ||
| 691 | /gnu/store/72f54nfp6g1hz873w8z3gfcah0h4nl9p-foo-0.1 | ||
| 692 | @result{} /gnu/store/…-foo-0.1 | ||
| 693 | @end example | ||
| 694 | |||
| 695 | Once you set up ``guix.el'' (@pxref{Emacs Initial Setup}), the following | ||
| 696 | commands become available: | ||
| 697 | |||
| 698 | @table @kbd | ||
| 699 | |||
| 700 | @item M-x guix-prettify-mode | ||
| 701 | Enable/disable prettifying for the current buffer. | ||
| 702 | |||
| 703 | @item M-x global-guix-prettify-mode | ||
| 704 | Enable/disable prettifying globally. | ||
| 705 | |||
| 706 | @end table | ||
| 707 | |||
| 708 | To automatically enable @code{guix-prettify-mode} globally on Emacs | ||
| 709 | start, add the following line to your init file: | ||
| 710 | |||
| 711 | @example | ||
| 712 | (global-guix-prettify-mode) | ||
| 713 | @end example | ||
| 714 | |||
| 715 | If you want to enable it only for specific major modes, add it to the | ||
| 716 | mode 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 | |||
| 727 | GNU@tie{}Guix provides major and minor modes for highlighting build | ||
| 728 | logs. So when you have a file with a package build output---for | ||
| 729 | example, a file returned by @command{guix build --log-file @dots{}} | ||
| 730 | command (@pxref{Invoking guix build}), you may call @kbd{M-x | ||
| 731 | guix-build-log-mode} command in the buffer with this file. This major | ||
| 732 | mode highlights some lines specific to build output and provides the | ||
| 733 | following key bindings: | ||
| 734 | |||
| 735 | @table @kbd | ||
| 736 | |||
| 737 | @item M-n | ||
| 738 | Move to the next build phase. | ||
| 739 | |||
| 740 | @item M-p | ||
| 741 | Move to the previous build phase. | ||
| 742 | |||
| 743 | @item @key{TAB} | ||
| 744 | Toggle (show/hide) the body of the current build phase. | ||
| 745 | |||
| 746 | @item S-@key{TAB} | ||
| 747 | Toggle (show/hide) the bodies of all build phases. | ||
| 748 | |||
| 749 | @end table | ||
| 750 | |||
| 751 | There is also @kbd{M-x guix-build-log-minor-mode} which also provides | ||
| 752 | the same highlighting and the same key bindings as the major mode, but | ||
| 753 | prefixed with @kbd{C-c}. By default, this minor mode is enabled in | ||
| 754 | shell buffers (@pxref{Interactive Shell,,, emacs, The GNU Emacs | ||
| 755 | Manual}). 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 | |||
| 762 | Another feature that becomes available after configuring Emacs interface | ||
| 763 | (@pxref{Emacs Initial Setup}) is completing of @command{guix} | ||
| 764 | subcommands, 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 | |||
| 768 | It works the same way as other completions do. Just press @key{TAB} | ||
| 769 | when your intuition tells you. | ||
| 770 | |||
| 771 | And here are some examples, where pressing @key{TAB} may complete | ||
| 772 | something: | ||
| 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 | |||
| 793 | By default, when you open a Scheme file, @code{guix-devel-mode} will be | ||
| 794 | activated (if you don't want it, set @code{guix-devel-activate-mode} to | ||
| 795 | nil). This minor mode provides the following key bindings: | ||
| 796 | |||
| 797 | @table @kbd | ||
| 798 | |||
| 799 | @item C-c . k | ||
| 800 | Copy the name of the current Guile module into kill ring | ||
| 801 | (@code{guix-devel-copy-module-as-kill}). | ||
| 802 | |||
| 803 | @item C-c . u | ||
| 804 | Use the current Guile module. Often after opening a Scheme file, you | ||
| 805 | want to use a module it defines, so you switch to the Geiser REPL and | ||
| 806 | write @code{,use (some module)} there. You may just use this command | ||
| 807 | instead (@code{guix-devel-use-module}). | ||
| 808 | |||
| 809 | @item C-c . b | ||
| 810 | Build a package defined by the current variable definition. The | ||
| 811 | building process is run in the current Geiser REPL. If you modified the | ||
| 812 | current package definition, don't forget to reevaluate it before calling | ||
| 813 | this command---for example, with @kbd{C-M-x} (@pxref{To eval or not to | ||
| 814 | eval,,, geiser, Geiser User Manual}) | ||
| 815 | (@code{guix-devel-build-package-definition}). | ||
| 816 | |||
| 817 | @item C-c . s | ||
| 818 | Build a source derivation of the package defined by the current variable | ||
| 819 | definition. This command has the same meaning as @code{guix build -S} | ||
| 820 | shell command (@pxref{Invoking guix build}) | ||
| 821 | (@code{guix-devel-build-package-source}). | ||
| 822 | |||
| 823 | @item C-c . l | ||
| 824 | Lint (check) a package defined by the current variable definition | ||
| 825 | (@pxref{Invoking guix lint}) (@code{guix-devel-lint-package}). | ||
| 826 | |||
| 827 | @end table | ||
| 828 | |||
| 829 | Unluckily, there is a limitation related to long-running REPL commands. | ||
| 830 | When there is a running process in a Geiser REPL, you are not supposed | ||
| 831 | to evaluate anything in a scheme buffer, because this will ``freeze'' | ||
| 832 | the REPL: it will stop producing any output (however, the evaluating | ||
| 833 | process will continue---you will just not see any progress anymore). Be | ||
| 834 | aware: even moving the point in a scheme buffer may ``break'' the REPL | ||
| 835 | if Autodoc (@pxref{Autodoc and friends,,, geiser, Geiser User Manual}) | ||
| 836 | is enabled (which is the default). | ||
| 837 | |||
| 838 | So you have to postpone editing your scheme buffers until the running | ||
| 839 | evaluation will be finished in the REPL. | ||
| 840 | |||
| 841 | Alternatively, to avoid this limitation, you may just run another Geiser | ||
| 842 | REPL, and while something is being evaluated in the previous REPL, you | ||
| 843 | can continue editing a scheme file with the help of the current one. | ||
| 844 | |||
| 845 | |||
| 846 | @node Emacs Hydra | ||
| 847 | @section Hydra | ||
| 848 | |||
| 849 | The continuous integration server at @code{hydra.gnu.org} builds all | ||
| 850 | the distribution packages on the supported architectures and serves | ||
| 851 | them as substitutes (@pxref{Substitutes}). Continuous integration is | ||
| 852 | currently orchestrated by @uref{https://nixos.org/hydra/, Hydra}. | ||
| 853 | |||
| 854 | This section describes an Emacs interface to query Hydra to know the | ||
| 855 | build status of specific packages, discover recent and ongoing builds, | ||
| 856 | view 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 | |||
| 860 | The following commands are available: | ||
| 861 | |||
| 862 | @table @kbd | ||
| 863 | |||
| 864 | @item M-x guix-hydra-latest-builds | ||
| 865 | Display latest failed or successful builds (you will be prompted for a | ||
| 866 | number of builds). With @kbd{C-u}, you will also be prompted for other | ||
| 867 | parameters (project, jobset, job and system). | ||
| 868 | |||
| 869 | @item M-x guix-hydra-queued-builds | ||
| 870 | Display scheduled or currently running builds (you will be prompted for | ||
| 871 | a number of builds). | ||
| 872 | |||
| 873 | @item M-x guix-hydra-jobsets | ||
| 874 | Display available jobsets (you will be prompted for a project). | ||
| 875 | |||
| 876 | @end table | ||
| 877 | |||
| 878 | In a list of builds you can press @kbd{L} key to display a build log of | ||
| 879 | the current build. Also both a list of builds and a list of jobsets | ||
| 880 | provide @kbd{B} key to display latest builds of the current job or | ||
| 881 | jobset (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 | ||
| 127 | Emacs 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 | |||
| 140 | Programming Interface | 120 | Programming 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 |
| 279 | Guix provides a command-line package management interface | 259 | Guix 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 |
| 282 | Interface}), as well as Scheme programming interfaces | ||
| 283 | (@pxref{Programming Interface}). | 262 | (@pxref{Programming Interface}). |
| 284 | @cindex build daemon | 263 | @cindex build daemon |
| 285 | Its @dfn{build daemon} is responsible for building packages on behalf of | 264 | Its @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 | |||
| 1414 | features. | 1393 | features. |
| 1415 | 1394 | ||
| 1416 | This chapter describes the main features of Guix, as well as the package | 1395 | This chapter describes the main features of Guix, as well as the package |
| 1417 | management tools it provides. Two user interfaces are provided for | 1396 | management tools it provides. Along with the command-line interface |
| 1418 | routine package management tasks: A command-line interface described below | 1397 | described below (@pxref{Invoking guix package, @code{guix package}}), |
| 1419 | (@pxref{Invoking guix package, @code{guix package}}), as well as a visual user | 1398 | you may also use Emacs Interface, after installing @code{emacs-guix} |
| 1420 | interface in Emacs described in a subsequent chapter (@pxref{Emacs Interface}). | 1399 | package (run @kbd{M-x guix-help} command to start with it): |
| 1400 | |||
| 1401 | @example | ||
| 1402 | guix 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 | ||
| 1435 | When using Guix, each package ends up in the @dfn{package store}, in its | 1418 | When using Guix, each package ends up in the @dfn{package store}, in its |
| 1436 | own directory---something that resembles | 1419 | own 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 | ||
| 1439 | names, @pxref{Emacs Prettify}.) | ||
| 1440 | 1421 | ||
| 1441 | Instead of referring to these directories, users have their own | 1422 | Instead 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 | ||
| 1983 | The @code{hydra.gnu.org} server is a front-end to a build farm that | 1964 | The @code{hydra.gnu.org} server is a front-end to a build farm that |
| 1984 | builds packages from the GNU distribution continuously for some | 1965 | builds packages from the GNU distribution continuously for some |
| 1985 | architectures, and makes them available as substitutes (@pxref{Emacs | 1966 | architectures, and makes them available as substitutes. This is the |
| 1986 | Hydra}, for information on how to query the continuous integration | ||
| 1987 | server). This is the | ||
| 1988 | default source of substitutes; it can be overridden by passing the | 1967 | default 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} | |||
| 4923 | recipes. Otherwise, you will be able to examine the read-only recipes | 4899 | recipes. Otherwise, you will be able to examine the read-only recipes |
| 4924 | for packages currently in the store. | 4900 | for packages currently in the store. |
| 4925 | 4901 | ||
| 4926 | If 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 | ||
| 4928 | info'' and ``package list'' buffers created by the @kbd{M-x | ||
| 4929 | guix-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/ | |||
| 219 | easejs mono ${GS}/easejs/manual/easejs.html | 219 | easejs mono ${GS}/easejs/manual/easejs.html |
| 220 | easejs node ${GS}/easejs/manual/ | 220 | easejs node ${GS}/easejs/manual/ |
| 221 | 221 | ||
| 222 | emacs-guix mono https://notabug.org/alezost/emacs-guix | ||
| 223 | |||
| 222 | emacs-muse node ${GS}/emacs-muse/manual/muse.html | 224 | emacs-muse node ${GS}/emacs-muse/manual/muse.html |
| 223 | emacs-muse node ${GS}/emacs-muse/manual/html_node/ | 225 | emacs-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. | ||
| 75 | Same as `geiser-repl-startup-time' but is used for Guix REPL. | ||
| 76 | If 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. | ||
| 92 | This allows to receive information about packages using an additional | ||
| 93 | REPL 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. | ||
| 100 | The 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. | ||
| 107 | If nil, do not load autoloads of the Emacs packages after | ||
| 108 | they 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. | ||
| 117 | This REPL is used for processing package actions and for | ||
| 118 | receiving 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. | ||
| 122 | This 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'. | ||
| 138 | This internal variable is used to distinguish Guix operations | ||
| 139 | from 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'. | ||
| 143 | This internal variable is used to define what actions should be | ||
| 144 | executed after the current operation succeeds. | ||
| 145 | See `guix-eval-in-repl' for details.") | ||
| 146 | |||
| 147 | (defun guix-repl-autoload-emacs-packages-maybe () | ||
| 148 | "Load autoloads for Emacs packages if needed. | ||
| 149 | See `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. | ||
| 187 | START-MSG and END-MSG are strings displayed in the minibuffer in | ||
| 188 | the beginning and in the end of the starting process. If nil, | ||
| 189 | display 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. | ||
| 199 | If INTERNAL is non-nil, start an internal REPL. | ||
| 200 | |||
| 201 | START-MSG and END-MSG are strings displayed in the minibuffer in | ||
| 202 | the beginning and in the end of the process. If nil, do not | ||
| 203 | display 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. | ||
| 232 | If ADDRESS is non-nil, connect to a remote guile process using | ||
| 233 | this 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'. | ||
| 272 | This 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. | ||
| 296 | If INTERNAL is non-nil, exit the internal REPL. | ||
| 297 | If NO-WAIT is non-nil, do not wait for the REPL process to exit: | ||
| 298 | send 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. | ||
| 310 | If 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. | ||
| 334 | If INTERNAL is non-nil (interactively with prefix), switch to the | ||
| 335 | additional 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. | ||
| 344 | If it is not set by a user, it is set after starting Guile REPL. | ||
| 345 | This directory is used to define package locations.") | ||
| 346 | |||
| 347 | (defun guix-read-directory () | ||
| 348 | "Return `guix-directory' or prompt for it. | ||
| 349 | This 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. | ||
| 369 | See `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. | ||
| 374 | See `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. | ||
| 379 | If OPERATION-BUFFER is non-nil, it should be a buffer from which | ||
| 380 | the current operation was performed. | ||
| 381 | |||
| 382 | If OPERATION-TYPE is non-nil, it should be a symbol. After | ||
| 383 | successful 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 | ||
| 59 | PROFILE's GENERATION. | ||
| 60 | |||
| 61 | If SYSTEM? is non-nil, then PROFILE is considered to be a system | ||
| 62 | profile. Unlike usual profiles, for a system profile, packages | ||
| 63 | are 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. | ||
| 73 | See `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. | ||
| 114 | Each element of the list has a form: | ||
| 115 | |||
| 116 | (KEY NAME VARIABLE) | ||
| 117 | |||
| 118 | KEY is a character that may be pressed during confirmation to | ||
| 119 | toggle the option. | ||
| 120 | NAME is a string displayed in the mode-line. | ||
| 121 | VARIABLE 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. | ||
| 151 | Return non-nil, if the operation should be continued; nil otherwise. | ||
| 152 | Ask 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. | ||
| 222 | Ask 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. | ||
| 236 | Ask 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. | ||
| 251 | This function has the same meaning as 'guix package --manifest' command. | ||
| 252 | See Info node `(guix) Invoking guix package' for details. | ||
| 253 | |||
| 254 | Interactively, use the current profile and prompt for manifest | ||
| 255 | FILE. 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. | ||
| 280 | The 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. | ||
| 367 | If 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. | ||
| 52 | The 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. | ||
| 73 | The following local variables are available inside BODY: | ||
| 74 | `%entries', `%buffer-type', `%entry-type', `%args'. | ||
| 75 | See `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'. | ||
| 87 | See `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 | ||
| 94 | element of `guix-buffer-item' structure. | ||
| 95 | NAME 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 "\ | ||
| 100 | Return '%s' of the current Guix buffer. | ||
| 101 | See `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. | ||
| 110 | See `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' | ||
| 121 | field of `guix-buffer-item' structure. | ||
| 122 | PREFIX and NAME should be strings." | ||
| 123 | (let ((fun-name (intern (concat prefix "-" name))) | ||
| 124 | (doc (format "\ | ||
| 125 | Return '%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. | ||
| 134 | See `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. | ||
| 146 | This 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. | ||
| 155 | Call an appropriate 'get-entries' function from `guix-buffer' | ||
| 156 | using 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. | ||
| 235 | HISTORY 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. | ||
| 258 | See `guix-buffer-item' for the meaning of BUFFER-TYPE, ENTRY-TYPE | ||
| 259 | and 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. | ||
| 267 | See `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. | ||
| 275 | See `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. | ||
| 287 | See `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. | ||
| 294 | This function is suitable for `revert-buffer-function'. | ||
| 295 | See `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'. | ||
| 305 | This hook is called before seting up a window position.") | ||
| 306 | |||
| 307 | (defun guix-buffer-redisplay () | ||
| 308 | "Redisplay the current Guix buffer. | ||
| 309 | Restore the point and window positions after redisplaying. | ||
| 310 | |||
| 311 | This 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. | ||
| 340 | Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... | ||
| 341 | |||
| 342 | Optional 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. | ||
| 377 | See `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. | ||
| 384 | See `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. | ||
| 391 | Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... | ||
| 392 | In the following description TYPE means ENTRY-TYPE-BUFFER-TYPE. | ||
| 393 | |||
| 394 | Required 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 | |||
| 412 | Optional 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 "\ | ||
| 486 | Function 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 "\ | ||
| 492 | Function used to show '%s' entries in '%s' buffer." | ||
| 493 | entry-type-str buffer-type-str)) | ||
| 494 | |||
| 495 | (defvar ,message-var ,message-val | ||
| 496 | ,(format "\ | ||
| 497 | Function used to display a message after showing '%s' entries. | ||
| 498 | If nil, do not display messages." | ||
| 499 | entry-type-str)) | ||
| 500 | |||
| 501 | (defcustom ,buffer-name-var ,buffer-name-val | ||
| 502 | ,(format "\ | ||
| 503 | Default name of '%s' buffer for displaying '%s' entries. | ||
| 504 | May be a string or a function returning a string. The function | ||
| 505 | is 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 "\ | ||
| 512 | Maximum number of items saved in history of `%S' buffer. | ||
| 513 | If 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 "\ | ||
| 520 | If 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 "\ | ||
| 537 | Show '%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 "\ | ||
| 549 | Function 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 "\ | ||
| 574 | Major 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 "\ | ||
| 579 | Function 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 "\ | ||
| 584 | Major 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 | ||
| 109 | activated 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. | ||
| 127 | STATE is a symbol denoting a state of the title. It should be | ||
| 128 | `start', `fail', `success' or `nil' (for a regexp matching any | ||
| 129 | state)." | ||
| 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. | ||
| 141 | STATE 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. | ||
| 196 | For `guix-build-log-mode' this map is used as is. | ||
| 197 | For `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. | ||
| 217 | If WITH-HEADER? is non-nil, do not skip 'starting phase ...' header. | ||
| 218 | Return 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. | ||
| 289 | With ARG, do it that many times. Negative ARG means move | ||
| 290 | backward." | ||
| 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. | ||
| 319 | With ARG, do it that many times. Negative ARG means move | ||
| 320 | forward." | ||
| 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 | |||
| 336 | With a prefix argument ARG, enable Guix Build Log minor mode if | ||
| 337 | ARG is positive, and disable it otherwise. If called from Lisp, | ||
| 338 | enable the mode if ARG is omitted or nil. | ||
| 339 | |||
| 340 | When Guix Build Log minor mode is enabled, it highlights build | ||
| 341 | log in the current buffer. This mode can be enabled | ||
| 342 | programmatically 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. | ||
| 79 | I.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. | ||
| 116 | Each assoc from ALIST have a form (NAME . PLIST). NAME is an | ||
| 117 | argument name. PLIST is a property list of argument parameters | ||
| 118 | to 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. | ||
| 408 | These are 'fake' arguments that are not presented in 'guix' shell | ||
| 409 | commands.") | ||
| 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 | ||
| 509 | a list of arguments returned from popup interface. | ||
| 510 | Each 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. | ||
| 518 | Call MODIFIER on each argument matching PREDICATE and append the | ||
| 519 | returned list of strings to the end of ARGS. Remove the original | ||
| 520 | arguments." | ||
| 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 | ||
| 536 | the end of ARGS list. If SPLIT? is non-nil, split matching | ||
| 537 | arguments 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 | ||
| 555 | and moving them to the end of ARGS list. | ||
| 556 | Remove '-- ' 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 | ||
| 564 | and moving them to the end of ARGS list. | ||
| 565 | Leave '--' 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' | ||
| 578 | command." | ||
| 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' | ||
| 586 | command." | ||
| 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. | ||
| 655 | See 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. | ||
| 676 | Do 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. | ||
| 684 | Perform 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 | ||
| 692 | open 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. | ||
| 745 | EXECUTOR 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.). | ||
| 50 | See 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 | ||
| 55 | in 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. | ||
| 65 | MODULE is a string with the module name - e.g., \"(ice-9 match)\". | ||
| 66 | Interactively, 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. | ||
| 103 | Bind DEF-VAR variable to the name of the current top-level | ||
| 104 | definition, setup the current REPL, use the current module, and | ||
| 105 | run 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. | ||
| 143 | See 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. | ||
| 161 | This 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. | ||
| 172 | This function is used as a PRE-MATCH-FORM for `font-lock-keywords' | ||
| 173 | to 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. | ||
| 242 | Each 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 | |||
| 342 | With a prefix argument ARG, enable the mode if ARG is positive, | ||
| 343 | and disable it otherwise. If called from Lisp, enable the mode | ||
| 344 | if ARG is omitted or nil. | ||
| 345 | |||
| 346 | When Guix Devel mode is enabled, it provides the following key | ||
| 347 | bindings: | ||
| 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. | ||
| 50 | Return 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. | ||
| 35 | May be either a string (the name of the executable) or a list of | ||
| 36 | strings of the form: | ||
| 37 | |||
| 38 | (NAME . ARGS) | ||
| 39 | |||
| 40 | Where 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. | ||
| 60 | The 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. | ||
| 67 | If 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. | ||
| 37 | If REPL is nil, use the current Geiser REPL. | ||
| 38 | Return 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. | ||
| 48 | Return 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. | ||
| 69 | This is the same as `geiser-repl--send', but with SAVE-HISTORY | ||
| 70 | argument. If SAVE-HISTORY is non-nil, save CMD in the REPL | ||
| 71 | history." | ||
| 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. | ||
| 84 | If NO-HISTORY is non-nil, do not save STR in the REPL history. | ||
| 85 | If 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 | ||
| 98 | REPL operation will be finished. | ||
| 99 | See `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. | ||
| 114 | PROC 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. | ||
| 120 | PROC 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. | ||
| 48 | Return 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. | ||
| 59 | Transform 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. | ||
| 68 | PROC 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, | ||
| 49 | guix 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 | ||
| 73 | options.") | ||
| 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. | ||
| 31 | A list of the form (FUNCTION [ARGS ...]). | ||
| 32 | The 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. | ||
| 37 | Each 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'. | ||
| 42 | Each 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. | ||
| 47 | If 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. | ||
| 68 | ITEM 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. | ||
| 163 | Status numbers are returned by Hydra API, names (symbols) are | ||
| 164 | used 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. | ||
| 168 | See `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 "\ | ||
| 272 | Show 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. | ||
| 325 | Interactively, prompt for NUMBER. With prefix argument, prompt | ||
| 326 | for 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. | ||
| 347 | ARGS are the same arguments as for `guix-hydra-build-latest-api-url'. | ||
| 348 | Interactively, prompt for NUMBER. With prefix argument, prompt | ||
| 349 | for 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. | ||
| 142 | Interactively, prompt for NUMBER. With prefix argument, prompt | ||
| 143 | for 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. | ||
| 98 | TYPE is the name of an allowed method. | ||
| 99 | ARGS is alist of (KEY . VALUE) pairs. | ||
| 100 | Skip 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. | ||
| 130 | SEARCH-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. | ||
| 145 | Call `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. | ||
| 152 | Each 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. | ||
| 177 | This 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. | ||
| 200 | Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... | ||
| 201 | |||
| 202 | Required keywords: | ||
| 203 | |||
| 204 | - `:search-types' - default value of the generated | ||
| 205 | `guix-ENTRY-TYPE-search-types' variable. | ||
| 206 | |||
| 207 | Optional 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 | |||
| 220 | The 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 "\ | ||
| 236 | Alist of search types and according URL functions. | ||
| 237 | Functions are used to define URL to receive '%s' entries." | ||
| 238 | entry-type-str)) | ||
| 239 | |||
| 240 | (defvar ,filters-var ,filters-val | ||
| 241 | ,(format "\ | ||
| 242 | List of filters for '%s' parameters. | ||
| 243 | Each filter is a function that should take an entry as a single | ||
| 244 | argument, 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 "\ | ||
| 255 | List of '%s' parameters that should be transformed to boolean values." | ||
| 256 | entry-type-str)) | ||
| 257 | |||
| 258 | (defun ,filter-bool-fun (entry) | ||
| 259 | ,(format "\ | ||
| 260 | Run `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 "\ | ||
| 277 | Alist of '%s' parameter names returned by Hydra API and names | ||
| 278 | used internally by the elisp code of this package." | ||
| 279 | entry-type-str)) | ||
| 280 | |||
| 281 | (defun ,filter-names-fun (entry) | ||
| 282 | ,(format "\ | ||
| 283 | Run `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 "\ | ||
| 292 | Receive '%s' entries. | ||
| 293 | See `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 | |||
| 311 | This macro should be called after calling | ||
| 312 | `guix-hydra-define-entry-type' with the same ENTRY-TYPE. | ||
| 313 | |||
| 314 | ARGS 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. | ||
| 329 | See `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. | ||
| 336 | Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... | ||
| 337 | |||
| 338 | Optional 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 | |||
| 344 | The 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. | ||
| 83 | If nil, insert text parameters (like synopsis or description) in | ||
| 84 | a 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. | ||
| 90 | It should be a '%s'-sequence. After inserting a title formatted | ||
| 91 | with this string, a value of the parameter is inserted. | ||
| 92 | This 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. | ||
| 98 | If a value occupies more than one line, this string is inserted | ||
| 99 | in the beginning of each line after the first one. | ||
| 100 | This 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. | ||
| 113 | This 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. | ||
| 188 | LEVEL 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. | ||
| 204 | If INDENT-LEVEL is non-nil, indent displayed data by this number | ||
| 205 | of `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. | ||
| 213 | ENTRY is alist with parameters and their values. | ||
| 214 | ENTRY-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. | ||
| 232 | If 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. | ||
| 239 | If 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 | |||
| 247 | VALUE may be split into several short lines to fit the current | ||
| 248 | window, depending on `guix-info-fill', and each line is indented | ||
| 249 | with INDENT number of spaces. | ||
| 250 | |||
| 251 | If BUTTON-OR-FACE is a button type symbol, transform VALUE into | ||
| 252 | this (these) button(s) and insert each one on a new line. If it | ||
| 253 | is 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 | |||
| 270 | This function is intended to be called after inserting a title | ||
| 271 | with `guix-info-insert-title-simple'. | ||
| 272 | |||
| 273 | VALUE may be split into several short lines to fit the current | ||
| 274 | window, depending on `guix-info-fill', and each line is indented | ||
| 275 | with `guix-info-indent'. | ||
| 276 | |||
| 277 | For 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 | |||
| 285 | This function is intended to be called after inserting a title | ||
| 286 | with `guix-info-insert-title-format'. | ||
| 287 | |||
| 288 | VALUE may be split into several short lines to fit the current | ||
| 289 | window, depending on `guix-info-fill' and | ||
| 290 | `guix-info-multiline-prefix'. If VALUE is a list, its elements | ||
| 291 | will be separated with `guix-list-separator'. | ||
| 292 | |||
| 293 | If BUTTON-OR-FACE is a button type symbol, transform VALUE into | ||
| 294 | this (these) button(s). If it is a face symbol, propertize | ||
| 295 | inserted line(s) with this face. | ||
| 296 | |||
| 297 | BUTTON-PROPERTIES are passed to `guix-buttonize' (only if | ||
| 298 | BUTTON-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. | ||
| 354 | If 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. | ||
| 363 | ACTION is a function called when the button is pressed. It | ||
| 364 | should accept button as the argument. | ||
| 365 | MESSAGE is a button message. | ||
| 366 | See `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. | ||
| 399 | Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... | ||
| 400 | |||
| 401 | Required keywords: | ||
| 402 | |||
| 403 | - `:format' - default value of the generated | ||
| 404 | `guix-ENTRY-TYPE-info-format' variable. | ||
| 405 | |||
| 406 | The 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 "\ | ||
| 419 | List of methods for inserting '%s' entry. | ||
| 420 | Each METHOD should be either a function or should have the | ||
| 421 | following form: | ||
| 422 | |||
| 423 | (PARAM INSERT-TITLE INSERT-VALUE) | ||
| 424 | |||
| 425 | If METHOD is a function, it is called with an entry as argument. | ||
| 426 | |||
| 427 | PARAM is a name of '%s' entry parameter. | ||
| 428 | |||
| 429 | INSERT-TITLE may be either a symbol or a list. If it is a | ||
| 430 | symbol, it should be a function or an alias from | ||
| 431 | `guix-info-title-aliases', in which case it is called with title | ||
| 432 | as argument. If it is a list, it should have a | ||
| 433 | form (FUN-OR-ALIAS [ARGS ...]), in which case FUN-OR-ALIAS is | ||
| 434 | called with title and ARGS as arguments. | ||
| 435 | |||
| 436 | INSERT-VALUE may be either a symbol or a list. If it is a | ||
| 437 | symbol, it should be a function or an alias from | ||
| 438 | `guix-info-value-aliases', in which case it is called with value | ||
| 439 | and entry as arguments. If it is a list, it should have a | ||
| 440 | form (FUN-OR-ALIAS [ARGS ...]), in which case FUN-OR-ALIAS is | ||
| 441 | called with value and ARGS as arguments. | ||
| 442 | |||
| 443 | Parameters are inserted in the same order as defined by this list. | ||
| 444 | After 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 "\ | ||
| 462 | Print '%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. | ||
| 32 | DIRECTORY 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. | ||
| 45 | See `guix-license-file' for the meaning of DIRECTORY. | ||
| 46 | Interactively, 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. | ||
| 54 | If no entries are marked, describe the current entry. | ||
| 55 | With 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. | ||
| 71 | This 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. | ||
| 115 | This function is used for sort predicates for `tabulated-list-format'. | ||
| 116 | Return 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. | ||
| 123 | See `guix-list-sort-numerically' for details." | ||
| 124 | (let ((name (intern (format "guix-list-sort-numerically-%d" column))) | ||
| 125 | (doc (format "\ | ||
| 126 | Predicate to sort tabulated list by column %d numerically. | ||
| 127 | See `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. | ||
| 135 | See `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 | |||
| 153 | FUN is applied to column specification as arguments (see | ||
| 154 | `guix-list-format'). | ||
| 155 | |||
| 156 | Return 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'. | ||
| 179 | Parameters 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. | ||
| 212 | VAL 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. | ||
| 263 | Call FUN with RESULT as argument for each line, using INIT as | ||
| 264 | the 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. | ||
| 275 | Each element of the list has a form: | ||
| 276 | |||
| 277 | (ID MARK-NAME . ARGS) | ||
| 278 | |||
| 279 | ID is an entry ID. | ||
| 280 | MARK-NAME is a symbol from `guix-list-marks'. | ||
| 281 | ARGS 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. | ||
| 311 | Entry specs are elements from `guix-list-marked' list. | ||
| 312 | If 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. | ||
| 324 | See `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. | ||
| 333 | See `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. | ||
| 338 | Also add the current entry to `guix-list-marked' using its ID and ARGS. | ||
| 339 | MARK-NAME is a symbol from `guix-list-marks'. | ||
| 340 | If 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. | ||
| 354 | With 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. | ||
| 362 | MARK-NAME is a symbol from `guix-list-marks'. | ||
| 363 | Interactively, 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. | ||
| 370 | With 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. | ||
| 398 | With a numeric prefix argument N, sort the Nth column. | ||
| 399 | Same 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. | ||
| 435 | Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... | ||
| 436 | |||
| 437 | Required keywords: | ||
| 438 | |||
| 439 | - `:format' - default value of the generated | ||
| 440 | `guix-ENTRY-TYPE-list-format' variable. | ||
| 441 | |||
| 442 | Optional 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 | |||
| 456 | The 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 "\ | ||
| 480 | List of format values of the displayed columns. | ||
| 481 | Each element of the list has a form: | ||
| 482 | |||
| 483 | (PARAM VALUE-FUN WIDTH SORT . PROPS) | ||
| 484 | |||
| 485 | PARAM is a name of '%s' entry parameter. | ||
| 486 | |||
| 487 | VALUE-FUN may be either nil or a function returning a value that | ||
| 488 | will be inserted. The function is called with 2 arguments: the | ||
| 489 | first one is the value of the parameter; the second one is an | ||
| 490 | entry (alist of parameter names and values). | ||
| 491 | |||
| 492 | For 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 "\ | ||
| 500 | Default sort key for 'list' buffer with '%s' entries. | ||
| 501 | Should be nil (no sort) or have a form: | ||
| 502 | |||
| 503 | (PARAM . FLIP) | ||
| 504 | |||
| 505 | PARAM is the name of '%s' entry parameter. For the meaning of | ||
| 506 | FLIP, 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 "\ | ||
| 514 | Alist of additional marks for 'list' buffer with '%s' entries. | ||
| 515 | Marks 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 "\ | ||
| 520 | If non-nil, list '%s' entry even if it is the only matching result. | ||
| 521 | If 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 "\ | ||
| 528 | The maximum number of '%s' entries to describe without a warning. | ||
| 529 | If a user wants to describe more than this number of marked | ||
| 530 | entries, he will be prompted for confirmation. | ||
| 531 | See 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 "\ | ||
| 559 | Print '%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 "\ | ||
| 565 | Set 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. | ||
| 33 | For 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. | ||
| 40 | LOCATION is a string of the form: | ||
| 41 | |||
| 42 | \"FILE:LINE:COLUMN\" | ||
| 43 | |||
| 44 | If FILE is relative, it is considered to be relative to | ||
| 45 | DIRECTORY (`guix-directory' by default). | ||
| 46 | |||
| 47 | Interactively, prompt for LOCATION. With prefix argument, prompt | ||
| 48 | for 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. | ||
| 66 | See `guix-find-location' for the meaning of package location and | ||
| 67 | DIRECTORY. | ||
| 68 | Interactively, 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, | ||
| 81 | return 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. | ||
| 120 | Each 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 | ||
| 129 | and 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. | ||
| 181 | Call (PROC NAME VERSION ENTRIES RESULT), using INIT as the initial value | ||
| 182 | of 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 | |||
| 192 | PARAM-ALIST is alist of available parameters (symbols) and procedures | ||
| 193 | returning values of these parameters. Each procedure is applied to | ||
| 194 | objects. | ||
| 195 | |||
| 196 | PARAMS is list of parameters from PARAM-ALIST that should be returned by | ||
| 197 | a resulting procedure. If PARAMS is not specified or is an empty list, | ||
| 198 | use all available parameters. | ||
| 199 | |||
| 200 | Example: | ||
| 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. | ||
| 395 | MATCH-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. | ||
| 455 | ID 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. | ||
| 489 | If OBSOLETE-ONLY? is #f, use all entries, otherwise make patterns only | ||
| 490 | for 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. | ||
| 503 | If OBSOLETE-ONLY? is #f, use all entries, otherwise make patterns only | ||
| 504 | for 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. | ||
| 525 | ENTRIES 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. | ||
| 720 | See '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. | ||
| 754 | If 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. | ||
| 783 | See '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 | ||
| 799 | PROFILE." | ||
| 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 | |||
| 827 | ENTRY-TYPE is a symbol defining a type of returning information. Should | ||
| 828 | be: 'package', 'output' or 'generation'. | ||
| 829 | |||
| 830 | SEARCH-TYPE and SEARCH-VALS define how to get the information. | ||
| 831 | SEARCH-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 | |||
| 840 | PARAMS is a list of parameters for receiving. If it is an empty list, | ||
| 841 | get 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 | |||
| 856 | Returning value is a list of alists. Each alist consists of | ||
| 857 | parameter/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. | ||
| 895 | PROC 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 | |||
| 914 | INSTALL, UPGRADE, REMOVE are lists of 'package action patterns'. | ||
| 915 | Each pattern should have the following form: | ||
| 916 | |||
| 917 | (ID . OUTPUTS) | ||
| 918 | |||
| 919 | ID is an object address or a full-name of a package. | ||
| 920 | OUTPUTS 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. | ||
| 947 | GENERATIONS 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. | ||
| 1007 | Return #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 | ||
| 1037 | defined by COMMAND-ARGS. | ||
| 1038 | Return #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. | ||
| 167 | Most likely, Guix REPL was restarted, so IDs are not actual | ||
| 168 | anymore, because they live only during the REPL process. | ||
| 169 | Try \"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. | ||
| 38 | It 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. | ||
| 45 | Insert 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. | ||
| 52 | Return a list of strings matching REGEXP. | ||
| 53 | GROUP 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 | |||
| 65 | The defined function takes an optional COMMAND argument. This | ||
| 66 | function will run 'guix COMMAND --help' (or 'guix --help' if | ||
| 67 | COMMAND is nil) using `guix-pcomplete-run-guix-and-search' and | ||
| 68 | return its result. | ||
| 69 | |||
| 70 | If FILTER is specified, it should be a function. The result is | ||
| 71 | passed to this FILTER as argument and the result value of this | ||
| 72 | function 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. | ||
| 86 | If COMMAND is non-nil (it should be a string), return available | ||
| 87 | subcommands, 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. | ||
| 152 | The first parenthesized group defines the option and the second | ||
| 153 | group - 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. | ||
| 160 | The first parenthesized group defines the option and the second | ||
| 161 | group - 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. | ||
| 227 | INPUT 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 | |||
| 67 | By default, after disabling `guix-prettify-mode', | ||
| 68 | compositions (prettifying names with `guix-prettify-char') are | ||
| 69 | removed only from strings matching `guix-prettify-regexp', so | ||
| 70 | that compositions created by other modes are left untouched. | ||
| 71 | |||
| 72 | Set this variable to non-nil, if you want to remove any | ||
| 73 | composition unconditionally (like `prettify-symbols-mode' does). | ||
| 74 | Most likely it will do no harm and will make the process of | ||
| 75 | disabling `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 | |||
| 93 | Disable `guix-prettify-mode' before modifying this variable and | ||
| 94 | make sure to modify `guix-prettify-regexp-group' if needed. | ||
| 95 | |||
| 96 | Example of a \"deeper\" prettifying: | ||
| 97 | |||
| 98 | (setq guix-prettify-regexp \"store/[[:alnum:]]\\\\\\={32\\\\}\" | ||
| 99 | guix-prettify-regexp-group 0) | ||
| 100 | |||
| 101 | This 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 | |||
| 116 | By default, \\[global-guix-prettify-mode] enables prettifying in | ||
| 117 | all buffers except the ones where `font-lock-defaults' is | ||
| 118 | nil (see Info node `(elisp) Font Lock Basics'), because it may | ||
| 119 | break the existing highlighting. | ||
| 120 | |||
| 121 | Modes 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. | ||
| 128 | This function is called without arguments after | ||
| 129 | enabling/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 | |||
| 157 | With a prefix argument ARG, enable Guix Prettify mode if ARG is | ||
| 158 | positive, and disable it otherwise. If called from Lisp, enable | ||
| 159 | the mode if ARG is omitted or nil. | ||
| 160 | |||
| 161 | When Guix Prettify mode is enabled, hash-parts of the Guix store | ||
| 162 | file names (see `guix-prettify-regexp') are prettified, | ||
| 163 | i.e. displayed as `guix-prettify-char' character. This mode can | ||
| 164 | be enabled programmatically using hooks: | ||
| 165 | |||
| 166 | (add-hook 'shell-mode-hook 'guix-prettify-mode) | ||
| 167 | |||
| 168 | It is possible to enable the mode in any buffer, however not any | ||
| 169 | buffer's highlighting may survive after adding new elements to | ||
| 170 | `font-lock-keywords' (see `guix-prettify-special-modes' for | ||
| 171 | details). | ||
| 172 | |||
| 173 | Also you can use `global-guix-prettify-mode' to enable Guix | ||
| 174 | Prettify 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. | ||
| 196 | See `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. | ||
| 53 | Use 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. | ||
| 65 | Interactively, 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 | |||
| 45 | If PROFILE is nil, use `guix-current-profile'. | ||
| 46 | |||
| 47 | See `guix-ui-get-entries' for the meaning of SEARCH-TYPE and | ||
| 48 | SEARCH-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. | ||
| 57 | Each 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 | ||
| 89 | current 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. | ||
| 189 | VAL 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. | ||
| 224 | If 2 generations are marked with \\[guix-list-mark], display | ||
| 225 | outputs installed in the latest marked generation that were not | ||
| 226 | installed 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. | ||
| 237 | If 2 generations are marked with \\[guix-list-mark], display | ||
| 238 | outputs not installed in the latest marked generation that were | ||
| 239 | installed 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. | ||
| 286 | With 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. | ||
| 294 | With 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. | ||
| 302 | With 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. | ||
| 323 | This function is called with 2 arguments: PROFILE (string) and | ||
| 324 | GENERATION (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. | ||
| 332 | If nil, generation packages are received only once. So when you | ||
| 333 | compare generation 1 and generation 2, the packages for both | ||
| 334 | generations will be received. Then if you compare generation 1 | ||
| 335 | and generation 3, only the packages for generation 3 will be | ||
| 336 | received. Thus if you use comparing of different generations a | ||
| 337 | lot, you may set this variable to nil to improve the | ||
| 338 | performance." | ||
| 339 | :type 'boolean | ||
| 340 | :group 'guix-generation) | ||
| 341 | |||
| 342 | (defvar guix-generation-output-name-width 30 | ||
| 343 | "Width of an output name \"column\". | ||
| 344 | This 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. | ||
| 348 | Each element of the list is a list of the package specification | ||
| 349 | and 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. | ||
| 359 | Use 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. | ||
| 366 | Use 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. | ||
| 394 | Create 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. | ||
| 407 | GENERATION 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. | ||
| 414 | GENERATION 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. | ||
| 425 | If PROFILE is nil, use `guix-current-profile'. | ||
| 426 | Interactively 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. | ||
| 433 | If PROFILE is nil, use `guix-current-profile'. | ||
| 434 | Interactively 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. | ||
| 443 | FROM and TO should be time values. | ||
| 444 | If PROFILE is nil, use `guix-current-profile'. | ||
| 445 | Interactively 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. | ||
| 38 | SEARCH-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. | ||
| 135 | See `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. | ||
| 49 | Should be a symbol `package' or `output' (if `output', display each | ||
| 50 | output on a separate line; if `package', display each package on | ||
| 51 | a 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. | ||
| 58 | Should be a symbol `package' or `output' (if `output', display | ||
| 59 | each output separately; if `package', display outputs inside | ||
| 60 | package 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 | |||
| 68 | If PROFILE is nil, use `guix-current-profile'. | ||
| 69 | |||
| 70 | See `guix-ui-get-entries' for the meaning of SEARCH-TYPE and | ||
| 71 | SEARCH-VALUES. | ||
| 72 | |||
| 73 | Results are displayed in the list buffer, unless a single package | ||
| 74 | is 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. | ||
| 133 | Each action is a list of the form: | ||
| 134 | |||
| 135 | (ACTION-TYPE PACKAGE-SPEC ...) | ||
| 136 | |||
| 137 | ACTION-TYPE is one of the following symbols: `install', | ||
| 138 | `upgrade', `remove'/`delete'. | ||
| 139 | PACKAGE-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. | ||
| 163 | Ask a user if needed (see `guix-operation-confirm'). | ||
| 164 | INSTALL, UPGRADE, REMOVE are 'package action specifications'. | ||
| 165 | See `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. | ||
| 194 | If 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. | ||
| 199 | See `guix-process-package-actions' for the meaning of SPECS. | ||
| 200 | ENTRIES 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. | ||
| 328 | If 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. | ||
| 334 | If 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. | ||
| 340 | After pressing a \"Show\" button, a derivation of the package | ||
| 341 | source is calculated and a store file path is displayed. If this | ||
| 342 | variable is non-nil and the source file does not exist in the | ||
| 343 | store, it will be automatically downloaded (with a possible | ||
| 344 | prompt 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. | ||
| 352 | Each 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. | ||
| 361 | It should be a '%s'-sequence. After inserting an output name | ||
| 362 | formatted 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. | ||
| 452 | TYPE is a type of inputs. | ||
| 453 | Function name is `guix-package-info-insert-TYPE-inputs'. | ||
| 454 | Face 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. | ||
| 502 | Make some fancy text with buttons and additional stuff if the | ||
| 503 | current 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. | ||
| 534 | TYPE is one of the following symbols: `install', `delete', `upgrade'. | ||
| 535 | ENTRY 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. | ||
| 554 | ENTRY-ID is an ID of the current entry (package or output). | ||
| 555 | PACKAGE-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. | ||
| 626 | Find the file if needed (see `guix-package-info-auto-find-source'). | ||
| 627 | ENTRY-ID is an ID of the current entry (package or output). | ||
| 628 | PACKAGE-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. | ||
| 657 | SOURCE 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. | ||
| 686 | This 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 | |||
| 732 | By default this is disabled, because it may be confusing. For | ||
| 733 | example, a package is installed in some generation, so a user can | ||
| 734 | mark it for deletion in the list of packages from this | ||
| 735 | generation, but the package may not be installed in the latest | ||
| 736 | generation, so actually it cannot be deleted. | ||
| 737 | |||
| 738 | If you managed to understand the explanation above or if you | ||
| 739 | really know what you do or if you just don't care, you can set | ||
| 740 | this variable to t. It should not do much harm anyway (most | ||
| 741 | likely)." | ||
| 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. | ||
| 747 | Colorize 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. | ||
| 773 | If PROMPT is non-nil, use it to ask a user for outputs from | ||
| 774 | AVAILABLE 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. | ||
| 783 | With ARG, prompt for the outputs to install (several outputs may | ||
| 784 | be 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. | ||
| 800 | With ARG, prompt for the outputs to delete (several outputs may | ||
| 801 | be 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. | ||
| 815 | With ARG, prompt for the outputs to upgrade (several outputs may | ||
| 816 | be 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. | ||
| 832 | Use FUN to perform marking of the current line. FUN should | ||
| 833 | take 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. | ||
| 860 | The 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 \ | ||
| 865 | profile '%s'. | ||
| 866 | Use '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. | ||
| 871 | Use FUN to define actions suitable for `guix-process-package-actions'. | ||
| 872 | FUN 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. | ||
| 888 | Return nil, if there are no packages marked with ACTION-TYPE. | ||
| 889 | The 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. | ||
| 895 | See `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. | ||
| 901 | Interactively, prompt for NUMBER. With prefix argument, prompt | ||
| 902 | for 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. | ||
| 1030 | Return nil, if there are no outputs marked with ACTION-TYPE. | ||
| 1031 | The 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). | ||
| 1039 | See `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. | ||
| 1057 | See `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. | ||
| 1075 | NAME is a string with name specification. It may optionally contain | ||
| 1076 | a version number. Examples: \"guile\", \"guile@2.0.11\". | ||
| 1077 | |||
| 1078 | If PROFILE is nil, use `guix-current-profile'. | ||
| 1079 | Interactively 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. | ||
| 1088 | LICENSE is a license name string. | ||
| 1089 | If PROFILE is nil, use `guix-current-profile'. | ||
| 1090 | Interactively 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. | ||
| 1099 | If PROFILE is nil, use `guix-current-profile'. | ||
| 1100 | Interactively 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. | ||
| 1109 | If PROFILE is nil, use `guix-current-profile'. | ||
| 1110 | Interactively 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. | ||
| 1122 | PARAMS are package parameters that should be searched. | ||
| 1123 | If PARAMS are not specified, use `guix-package-search-params'. | ||
| 1124 | |||
| 1125 | If PROFILE is nil, use `guix-current-profile'. | ||
| 1126 | Interactively 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. | ||
| 1136 | If PROFILE is nil, use `guix-current-profile'. | ||
| 1137 | Interactively 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. | ||
| 1147 | If PROFILE is nil, use `guix-current-profile'. | ||
| 1148 | Interactively 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. | ||
| 1168 | If PROFILE is nil, use `guix-current-profile'. | ||
| 1169 | Interactively 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. | ||
| 1176 | If PROFILE is nil, use `guix-current-profile'. | ||
| 1177 | Interactively 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. | ||
| 1184 | If PROFILE is nil, use `guix-current-profile'. | ||
| 1185 | Interactively 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. | ||
| 37 | See `guix-ui-get-entries' for the meaning of SEARCH-TYPE and | ||
| 38 | SEARCH-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 "\ | ||
| 37 | Settings for 'ui' (Guix package management) buffers. | ||
| 38 | This group includes settings for displaying packages, outputs and | ||
| 39 | generations 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. | ||
| 53 | This 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. | ||
| 61 | Call an appropriate scheme procedure and return a list of entries. | ||
| 62 | |||
| 63 | ENTRY-TYPE should be one of the following symbols: `package', | ||
| 64 | `output' or `generation'. | ||
| 65 | |||
| 66 | SEARCH-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 | |||
| 74 | PARAMS is a list of parameters for receiving. If nil, get data | ||
| 75 | with 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 | |||
| 94 | After successful executing an operation in the Guix REPL (for | ||
| 95 | example after installing a package), the data in Guix buffers | ||
| 96 | will or will not be automatically updated depending on a value of | ||
| 97 | this variable. | ||
| 98 | |||
| 99 | If nil, update nothing (do not revert any buffer). | ||
| 100 | If `current', update the buffer from which an operation was performed. | ||
| 101 | If `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. | ||
| 110 | The 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. | ||
| 132 | See `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. | ||
| 138 | If BUFFER is nil, check current buffer. | ||
| 139 | If 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. | ||
| 146 | If 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. | ||
| 158 | See `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. | ||
| 177 | Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... | ||
| 178 | |||
| 179 | The 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. | ||
| 189 | Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... | ||
| 190 | In the following description TYPE means ENTRY-TYPE-BUFFER-TYPE. | ||
| 191 | |||
| 192 | Required 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 | |||
| 198 | Optional keywords: | ||
| 199 | |||
| 200 | - `:required' - default value of the generated | ||
| 201 | `guix-TYPE-required-params' variable. | ||
| 202 | |||
| 203 | The rest keyword arguments are passed to | ||
| 204 | `guix-BUFFER-TYPE-define-interface' macro. | ||
| 205 | |||
| 206 | Along 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 "\ | ||
| 244 | List of the required '%s' parameters. | ||
| 245 | These parameters are received by `%S' | ||
| 246 | along with the displayed parameters. | ||
| 247 | |||
| 248 | Do not remove `id' from this list as it is required for | ||
| 249 | identifying an entry." | ||
| 250 | entry-type-str get-fun)) | ||
| 251 | |||
| 252 | (defun ,buffer-name-fun (profile &rest _) | ||
| 253 | ,(format "\ | ||
| 254 | Return a name of '%s' buffer for displaying '%s' entries. | ||
| 255 | See `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 "\ | ||
| 261 | Receive '%s' entries for displaying them in '%s' buffer. | ||
| 262 | See `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 "\ | ||
| 272 | Display 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. | ||
| 285 | See `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. | ||
| 292 | Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... | ||
| 293 | |||
| 294 | Optional 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 | |||
| 300 | The 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. | ||
| 34 | For 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 | |||
| 39 | VAL can be an expression of any type. | ||
| 40 | If VAL is t/nil, it is replaced with | ||
| 41 | `guix-true-string'/`guix-false-string'. | ||
| 42 | If VAL is list, its elements are concatenated using | ||
| 43 | `guix-list-separator'. | ||
| 44 | |||
| 45 | If 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. | ||
| 60 | Use `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. | ||
| 80 | If FACE is non-nil, propertize VAL with FACE. | ||
| 81 | If 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. | ||
| 89 | Apply FUNCTION to each element of SEQUENCE, and insert SEPARATOR | ||
| 90 | at point between each FUNCTION call. | ||
| 91 | |||
| 92 | If INDENT is non-nil, it should be a number of spaces used to | ||
| 93 | indent each line of the inserted text. | ||
| 94 | |||
| 95 | If COLUMN is non-nil, it should be a column number which | ||
| 96 | shouldn'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. | ||
| 117 | See `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. | ||
| 126 | Return a string with button(s). | ||
| 127 | |||
| 128 | VALUE should be a string or a list of strings. If it is a list | ||
| 129 | of strings, buttons are separated with SEPARATOR string. | ||
| 130 | |||
| 131 | PROPERTIES 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 | |||
| 149 | If FACE is non-nil, propertize returned string with this FACE. | ||
| 150 | |||
| 151 | If COL is non-nil and result string is a one-line string longer | ||
| 152 | than COL, split it into several short lines. | ||
| 153 | |||
| 154 | Separate 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. | ||
| 164 | If 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. | ||
| 180 | If LOCATION is a symbol `head', add another SEPARATOR to the | ||
| 181 | beginning of the returned string; if `tail' - add SEPARATOR to | ||
| 182 | the end of the string; if nil, do not add SEPARATOR; otherwise | ||
| 183 | add 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. | ||
| 200 | Return 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. | ||
| 205 | This 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. | ||
| 215 | This 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'. | ||
| 233 | If 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'. | ||
| 240 | See 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 | |||
| 246 | In a simple case the result is: | ||
| 247 | |||
| 248 | BASE-NAME: POSTFIX | ||
| 249 | |||
| 250 | If 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'. | ||
| 292 | Return 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. | ||
| 299 | This function is similar to `read-file-name' except it also | ||
| 300 | expands 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. | ||
| 306 | The function is called by `guix-find-file' with a file name as a | ||
| 307 | single 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. | ||
| 348 | OBJECT is passed as an argument to the first function from | ||
| 349 | MODIFIERS list, the returned result is passed to the second | ||
| 350 | function from the list and so on. Return result of the last | ||
| 351 | modifier 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 | |||
| 360 | Find keyword values in ARGS, bind them to variables according to | ||
| 361 | VARLIST, then evaluate BODY. | ||
| 362 | |||
| 363 | ARGS is a keyword/value property list. | ||
| 364 | |||
| 365 | Each element of VARLIST has a form: | ||
| 366 | |||
| 367 | (SYMBOL KEYWORD [DEFAULT-VALUE]) | ||
| 368 | |||
| 369 | SYMBOL is a varible name. KEYWORD is a symbol that will be | ||
| 370 | searched in ARGS for an according value. If the value of KEYWORD | ||
| 371 | does not exist, bind SYMBOL to DEFAULT-VALUE or nil. | ||
| 372 | |||
| 373 | The rest arguments (that present in ARGS but not in VARLIST) will | ||
| 374 | be bound to `%foreign-args' variable. | ||
| 375 | |||
| 376 | Example: | ||
| 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'. | ||
| 413 | ALIST is alist of alists of alists ... which can be consecutively | ||
| 414 | accessed 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. | ||
| 427 | Return the new alist. | ||
| 428 | |||
| 429 | ALIST is alist of alists of alists ... which can be consecutively | ||
| 430 | accessed with KEYS. | ||
| 431 | |||
| 432 | Example: | ||
| 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. | ||
| 463 | See `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. | ||
| 482 | READ-FUN may be `completing-read', `completing-read-multiple' or | ||
| 483 | another 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 | |||
| 493 | ARGS should have a form [KEYWORD VALUE] ... The following | ||
| 494 | keywords 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. | ||
| 564 | See `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 | |||
| 20 | AUTOLOADS = %D%/guix-autoloads.el | ||
| 21 | |||
| 22 | ELFILES = \ | ||
| 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 | |||
| 59 | if HAVE_EMACS | ||
| 60 | |||
| 61 | dist_lisp_DATA = $(ELFILES) | ||
| 62 | |||
| 63 | nodist_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 | |||
| 75 | CLEANFILES += $(AUTOLOADS) | ||
| 76 | |||
| 77 | endif 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") |
