forked from tribes/guix
Compare commits
452 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
| 0602d92bb0 | |||
| ca9050d517 | |||
| 0c8491cbbe | |||
| c490a0b037 | |||
| ea7b5a8f3d | |||
| 2c13d74181 | |||
| 3c0f7910e4 | |||
| 88f2dd1ddf | |||
| 39dc70323c | |||
| 082be6d2a1 | |||
| 74d212911e | |||
| 6d3e08d4e8 | |||
| d4acb6db2f | |||
| 3720371580 | |||
| 1545a012cb | |||
| 022c977258 | |||
| dd1141eba2 | |||
| b1a505baf6 | |||
| f3e44f5cd0 | |||
| ab4e939c50 | |||
| 26905ec8a6 | |||
| 313880c73a | |||
| f03168327f | |||
| cba53c60d5 | |||
| d33f889dac | |||
| 75fd35b670 | |||
| 28fd01bceb | |||
| f6b1dd233d | |||
| 5ed962263c | |||
| 5ba5b4b240 | |||
| 4f903085ac | |||
| 04927b6f26 | |||
| cac19f0df9 | |||
| dea228cf12 | |||
| 84aafbbb66 | |||
| 5d18d776d2 | |||
| 834458f6ff | |||
| ab4a1731d8 | |||
| c5793e7eb7 | |||
| 7bbf2e39f7 | |||
| 392c26b0d1 | |||
| 814b18e587 | |||
| ee719fba2d | |||
| f048f12ba1 | |||
| bb0756c7c7 | |||
| 96404be814 | |||
| 86c41ec3e4 | |||
| 989862005a | |||
| b9acdad717 | |||
| 78cef99b98 | |||
| 84bf2a2e74 | |||
| 5b4946180e | |||
| 9e3e972d1e | |||
| dfb01baec4 | |||
| ec460a2a37 | |||
| 3a3e309975 | |||
| 6499893ef8 | |||
| 57fe28a082 | |||
| 0860081413 | |||
| 1c9cea74b4 | |||
| 261f56914c | |||
| 2b84170782 | |||
| e10872cc83 | |||
| b2859a4fef | |||
| 01445711db | |||
| 9385f0e9cb | |||
| d7d5050c51 | |||
| a2bd16ff99 | |||
| 0102fba27c | |||
| b4774d87e4 | |||
| 8837860c66 | |||
| 9657aeb187 | |||
| aa21c764d6 | |||
| 707c65aad7 | |||
| 03476a23ff | |||
| 3a3bf2f819 | |||
| d407bdb931 | |||
| 6193563a36 | |||
| 974e02da76 | |||
| fab2784dbb | |||
| adb41527ad | |||
| 9af6bce1e1 | |||
| 7ef335b0e8 | |||
| dbf9d37114 | |||
| 0c37e2a3d2 | |||
| e50d5b8c9d | |||
| e0c32fc817 | |||
| 491b78a8e8 | |||
| 76c31074c8 | |||
| fbec5abeef | |||
| 6d943e553d | |||
| ec14d2157d | |||
| 922ab34446 | |||
| cfb9026aa5 | |||
| 6c8a387af2 | |||
| 12c15242f4 | |||
| 543bd0eede | |||
| e0101b54b7 | |||
| f537ad0bf3 | |||
| 5b2834ae79 | |||
| d9d23101ce | |||
| 1bd858cc14 | |||
| 807a5b32bf | |||
| 754bfd7019 | |||
| 89cd988b6c | |||
| abe2ec735f | |||
| 88a46c9812 | |||
| 19e5fb6030 | |||
| 8e941f2068 | |||
| 69355e1283 | |||
| 5f0fabec54 | |||
| 7a203059d3 | |||
| 3dcaa1226d | |||
| 337273e41f | |||
| 9c64f76e8a | |||
| 68f9067324 | |||
| 6548e53fcb | |||
| eb1ba73185 | |||
| 63147e5e1e | |||
| a359c7277c | |||
| 704b990c36 | |||
| 44c23cb8d8 | |||
| a5b5bd1d18 | |||
| 3d598ebd35 | |||
| 0472836fce | |||
| ff891f10ed | |||
| b96a0640a3 | |||
| a614ce389f | |||
| d38bc9a9f6 | |||
| ddf2b503b1 | |||
| 93eeadf022 | |||
| bc2c3bc627 | |||
| 7a76b4afd0 | |||
| ad3d730e3a | |||
| 56f73eadc0 | |||
| e6876cb9dc | |||
| e0ddaa8be3 | |||
| 2b1f7b83f7 | |||
| 796a17ab01 | |||
| 8bd10c1082 | |||
| 1ff755d1d5 | |||
| d8e0a08c26 | |||
| 3254e1aba9 | |||
| 5a16d828b3 | |||
| 4e17fff386 | |||
| ea3b38f1e1 | |||
| ae482ce12d | |||
| c7a7129c5a | |||
| c0d5b6452b | |||
| ee17a9e06e | |||
| 9b4ec5730a | |||
| de793e9a5a | |||
| 3b7ccbe94c | |||
| b5a09649db | |||
| 2d2388e243 | |||
| 324f4fc559 | |||
| 37e8a2e219 | |||
| f7e9f1cadc | |||
| eb5378f902 | |||
| 648733dc14 | |||
| bc47382a5d | |||
| f3a53f3c8f | |||
| 8efd807f95 | |||
| 3b40213923 | |||
| 835d371f4b | |||
| 0b2a91d8b7 | |||
| 02dadd3827 | |||
| 3b3b60d037 | |||
| 0916dc526e | |||
| ea5cc29561 | |||
| f339f2773d | |||
| 7637de2313 | |||
| e871c332a0 | |||
| e3dd1f0cb8 | |||
| 9e0f16f23f | |||
| 4d0a3d8e9f | |||
| 70c6341110 | |||
| e2c3037427 | |||
| 484437bd43 | |||
| 367f701379 | |||
| 62596a158b | |||
| 6a37872cd2 | |||
| b9b6db45e8 | |||
| d338237d8c | |||
| 4e9ae301ce | |||
| 3b9b12ef49 | |||
| 7b030c9f9b | |||
| 0c74399d98 | |||
| 807db78fc9 | |||
| 437d064dc5 | |||
| 596fcfac88 | |||
| da13738ef0 | |||
| 407a280103 | |||
| ac370a3397 | |||
| 4fb14fad94 | |||
| b1251a2f96 | |||
| 6155186838 | |||
| 47932c0d44 | |||
| b3e2ea8d48 | |||
| d925cdc35f | |||
| 5819431c59 | |||
| 125e3cdece | |||
| 832d60dc01 | |||
| 8d2de491e5 | |||
| 68b3627cd6 | |||
| 4b50daab00 | |||
| eeb05e87d3 | |||
| 1a49a10a94 | |||
| 7355634db3 | |||
| 9af076245f | |||
| 1b5ea0922f | |||
| 1f89fb1691 | |||
| 3753f2e6e9 | |||
| af27e845e1 | |||
| bbb99d6b37 | |||
| 27f9148e1d | |||
| d79fa7da1b | |||
| 819939cb94 | |||
| 5043b20dcd | |||
| 0d48ff811f | |||
| 27ccefc3d2 | |||
| 2e161eafd8 | |||
| 9a93f57473 | |||
| f90f6b683e | |||
| abdd28e8c1 | |||
| 74d862e8a2 | |||
| a6e0ae4046 | |||
| 231eddc88a | |||
| 8de938d59a | |||
| fef494d27d | |||
| 5e2e4a51f9 | |||
| 4a6e889feb | |||
| 7be13d0006 | |||
| 5dbeccf5b4 | |||
| ed88dd4512 | |||
| e63b19f509 | |||
| f1d136957d | |||
| f53a5514e0 | |||
| dc77498c1c | |||
| 395bbfdbea | |||
| 3ebc86d9bd | |||
| 0a7860c438 | |||
| c6b96af794 | |||
| 150e0a1ec6 | |||
| eb88fbafcd | |||
| 0d0079b2c5 | |||
| 68cb27840e | |||
| 2d7c92134e | |||
| 6f5b1c9107 | |||
| c26ba570cc | |||
| 636c77d066 | |||
| 6f7bcaad6a | |||
| c50dc711a1 | |||
| 25d84d3122 | |||
| 322a583fcf | |||
| 7fc2d377d1 | |||
| f11c444d44 | |||
| 13164a2102 | |||
| 23973e4fbf | |||
| e9629e8221 | |||
| c0b2d08bf4 | |||
| b13a5b4d16 | |||
| 0c315fb394 | |||
| 234ade2d7b | |||
| ab0c342924 | |||
| 42734b9a88 | |||
| ae476d01da | |||
| f165648e1b | |||
| 45cc957c72 | |||
| 594358f5b6 | |||
| a5f92ca04f | |||
| bf5e4bc42a | |||
| 7d2e758df5 | |||
| c055a37c8c | |||
| a3a2774501 | |||
| da62a4a19e | |||
| 0f391063d9 | |||
| 987a29ba43 | |||
| 68415aa4e1 | |||
| 858b9afeaf | |||
| 6023041346 | |||
| 4037e5f52b | |||
| a29929b32c | |||
| 95d7d0c57f | |||
| 3547a5effe | |||
| 87b5209558 | |||
| 76b64381cb | |||
| 2f642e5229 | |||
| 72c2693b9e | |||
| 5796af9981 | |||
| 5d3acc0b36 | |||
| 81a17b61e7 | |||
| 54d9b568fc | |||
| 86fc9c4a2c | |||
| c8ad8b6976 | |||
| 007ee80277 | |||
| d0f0579e6f | |||
| a57495e27a | |||
| 35bb2ff88a | |||
| 28c041afe8 | |||
| ab607061cd | |||
| 0811f0f9d2 | |||
| ca380feb37 | |||
| 046e27e3f5 | |||
| a8e45b3240 | |||
| b1c1f4d012 | |||
| c729d3dc0e | |||
| 53941eb7a5 | |||
| 3a181dc46e | |||
| 54aa6eb6ee | |||
| 1a44753b95 | |||
| 62350c0797 | |||
| 3607afbe4c | |||
| eaec5506ad | |||
| fd7810d323 | |||
| dd4ae2950a | |||
| 48a87bbe3b | |||
| ab01f1cdb1 | |||
| b94b03b7fa | |||
| 8a8fc31c6a | |||
| 421f7772b4 | |||
| 2a1c1b8074 | |||
| 85455a08f4 | |||
| abb6f0540e | |||
| db1b38af4e | |||
| 773a50114c | |||
| 76ce7c3767 | |||
| 58b93ad5d9 | |||
| eebac90aa8 | |||
| 9cdf10f1c9 | |||
| c616810720 | |||
| f4ca28d911 | |||
| d3122150ca | |||
| deb6276dda | |||
| 94a6f20baf | |||
| 2fd261a37a | |||
| 294304169a | |||
| 649d0c4841 | |||
| 6ba279853c | |||
| 069581351b | |||
| fc604eda3d | |||
| 322e724bfa | |||
| 8ecc3c6c44 | |||
| 681a555b83 | |||
| 36225d4fef | |||
| d835c6cc4b | |||
| b954256337 | |||
| e62e975b1f | |||
| e7b9da2411 | |||
| 43c0b9beaf | |||
| d5bbf806f3 | |||
| 789de5e279 | |||
| a0e41de4ab | |||
| 03702173f1 | |||
| 3ef00f5609 | |||
| 0151a8df22 | |||
| 460fccd4b3 | |||
| 9f21414de4 | |||
| a2c7d88e74 | |||
| a7ad802be5 | |||
| 50f7da2fc8 | |||
| 6a34f4ccc8 | |||
| 791ac6a68d | |||
| 2ee57340f4 | |||
| ffb1e98d74 | |||
| 1d9c889881 | |||
| 517c3207d3 | |||
| 48dc9f3af3 | |||
| 4dbaa12f5d | |||
| d531b9fdfe | |||
| 9e6c7c425e | |||
| ea8450c82a | |||
| 2c8d6c0be4 | |||
| 1194575b3c | |||
| 4de2a710a6 | |||
| 91426243f1 | |||
| 9916ef8bb6 | |||
| c976b319fe | |||
| f1775db660 | |||
| 328398e752 | |||
| fb222fb2b0 | |||
| b2f1f7b0d9 | |||
| 9f74424f37 | |||
| 33ca551731 | |||
| f077aa2b29 | |||
| db10a5e78a | |||
| 4a95b3882d | |||
| d02fb7cec6 | |||
| c88bee0ace | |||
| 3a2bcac6bd | |||
| 0c83c6bf26 | |||
| daa481f59a | |||
| 457d154fdf | |||
| 7604106f2c | |||
| db82557013 | |||
| f7fb34a06c | |||
| b672e1ed1e | |||
| 4d2fd1c016 | |||
| 8769d482ef | |||
| eed2a95e9f | |||
| 41d23dd1e2 | |||
| 50e9f81a22 | |||
| 4ec08b637b | |||
| a0e43c9fa7 | |||
| 426e6083ae | |||
| d0f1673dc3 | |||
| 14251e30c4 | |||
| b881dc6d98 | |||
| d205f895ca | |||
| 4b4ff6938d | |||
| e813f3956e | |||
| a532a6711e | |||
| 572ee05c31 | |||
| 059b3aa9c3 | |||
| 8e401ab6db | |||
| 8bf4a6aecd | |||
| 5d0ebcc4cf | |||
| 0d1baed223 | |||
| 7c247809ef | |||
| 590b80d29a | |||
| d1f3063196 | |||
| d229ba9502 | |||
| 4da696877c | |||
| 8afd19585f | |||
| 054fea97b7 | |||
| c8c385a04a | |||
| f05f5b307e | |||
| 9fa7284155 | |||
| e177f819c0 | |||
| 7aef9930f0 | |||
| 82f44a36e4 | |||
| 42366b35c3 | |||
| 6a148b9db5 | |||
| 21eced80a0 | |||
| 64b5e41376 | |||
| 899358d18a | |||
| 837ca0f071 | |||
| c55fa42b2d | |||
| 329e0a9ca0 | |||
| de75f0b1bf | |||
| abe5d2dc8d | |||
| e31d35de3f | |||
| 8cb3e7e7de | |||
| 4f6ff977c2 | |||
| 6eda11de44 | |||
| 62bd24db39 | |||
| f943c317fb | |||
| 7d2511bc6b | |||
| 3a35070c50 | |||
| 06fcd4a89e | |||
| b20644ed18 | |||
| 4cb7786eff |
@@ -2,24 +2,32 @@
|
||||
# contributors reported by "git log" and "git shortlog" commands.
|
||||
|
||||
Al McElrath <hello@yrns.org> <hello@atonesir.com>
|
||||
Alex Sassmannshausen <alex@pompo.co> <alex.sassmannshausen@gmail.com>
|
||||
Alexander I. Grafov <grafov@gmail.com>
|
||||
Alírio Eyng <alirioeyng@gmail.com>
|
||||
Amirouche Boubekki <amirouche@hypermove.net>
|
||||
Andreas Enge <andreas@enge.fr> <andreas.enge@inria.fr>
|
||||
Andreas Enge <andreas@enge.fr> <privat@xobs-novena>
|
||||
Andy Wingo <wingo@igalia.com> <wingo@pobox.com>
|
||||
Ben Woodcroft <donttrustben@gmail.com>
|
||||
Ben Woodcroft <donttrustben@gmail.com> <b.woodcroft@uq.edu.au>
|
||||
Ben Woodcroft <donttrustben@gmail.com> <donttrustben near gmail.com>
|
||||
Claes Wallin (韋嘉誠) <claes.wallin@greatsinodevelopment.com>
|
||||
Cyprien Nicolas <cyprien@nicolas.tf> <c.nicolas+gitorious@gmail.com>
|
||||
Daniel Pimentel <d4n1@d4n1.org> <d4n1@member.fsf.org>
|
||||
Danny Milosavljevic <dannym@scratchpost.org> <dannym+a@scratchpost.org>
|
||||
David Hashe <david.hashe@dhashe.com> <address@hidden>
|
||||
David Thompson <davet@gnu.org> <dthompson2@worcester.edu>
|
||||
David Thompson <davet@gnu.org> <dthompson@member.fsf.org>
|
||||
David Thompson <davet@gnu.org> <dthompson@vistahigherlearning.com>
|
||||
Deck Pickard <deck.r.pickard@gmail.com> <nebu@kipple>
|
||||
Eric Bavier <bavier@member.fsf.org> <ericbavier@gmail.com>
|
||||
Eric Dvorsak <eric@dvorsak.fr> <yenda1@gmail.com>
|
||||
George Clemmer <myglc2@gmail.com>
|
||||
Ivan Vilata i Balaguer <ivan@selidor.net>
|
||||
Jeff Mickey <j@codemac.net> <jm@igneous.io>
|
||||
John Darrington <jmd@gnu.org> <john@darrington.wattle.id.au>
|
||||
John J. Foerch <jjfoerch@earthlink.net>
|
||||
Joshua Grant <tadni@riseup.net> <gzg@riseup.net>
|
||||
Joshua Grant <tadni@riseup.net> <jgrant@parenthetical.io>
|
||||
Joshua Grant <tadni@riseup.net> <tadnimi@gmail.com>
|
||||
@@ -27,6 +35,8 @@ Joshua Grant <tadni@riseup.net> <youlysses@riseup.net>
|
||||
Kei Kebreau <kei@openmailbox.org>
|
||||
Leo Famulari <leo@famulari.name> <lfamular@gmail.com>
|
||||
Ludovic Courtès <ludo@gnu.org> <ludovic.courtes@inria.fr>
|
||||
Marek Benc <dusxmt@gmx.com> <merkur32@gmail.com>
|
||||
Marius Bakke <mbakke@fastmail.com> <m.bakke@warwick.ac.uk>
|
||||
Mathieu Lirzin <mthl@gnu.org> <mthl@openmailbox.org>
|
||||
Mathieu Lirzin <mthl@gnu.org> <mathieu.lirzin@openmailbox.org>
|
||||
Nikita Karetnikov <nikita@karetnikov.org> <nikita.karetnikov@gmail.com>
|
||||
@@ -35,13 +45,20 @@ ng0 <ng0@libertad.pw> <ngillmann@runbox.com>
|
||||
ng0 <ng0@libertad.pw> <niasterisk@grrlz.net>
|
||||
ng0 <ng0@libertad.pw> <ng@niasterisk.space>
|
||||
ng0 <ng0@libertad.pw>
|
||||
Pjotr Prins <pjotr.public01@thebird.nl>
|
||||
Pjotr Prins <pjotr.public01@thebird.nl> <pjotr.public12@thebird.nl>
|
||||
Pjotr Prins <pjotr.guix@thebird.nl> <pjotr.public01@thebird.nl>
|
||||
Pjotr Prins <pjotr.guix@thebird.nl> <pjotr.public12@thebird.nl>
|
||||
Pjotr Prins <pjotr.guix@thebird.nl> <pjotr.public12@email>
|
||||
Raimon Grau <raimonster@gmail.com> <raimon@3scale.net>
|
||||
Raoul Jean Pierre Bonnal <ilpuccio.febo@gmail.com>
|
||||
Raymond Nicholson <rain1@openmailbox.org>
|
||||
Rene Saavedra <rennes@openmailbox.org>
|
||||
Ricardo Wurmus <rekado@elephly.net>
|
||||
Ricardo Wurmus <rekado@elephly.net> <ricardo.wurmus@mdc-berlin.de>
|
||||
Sou Bunnbu (宋文武) <iyzsong@gmail.com>
|
||||
Sou Bunnbu (宋文武) <iyzsong@gmail.com> <iyzsong@member.fsf.org>
|
||||
Stefan Reichör <stefan@xsteve.at>
|
||||
Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
|
||||
Thomas Danckaert <thomas.danckaert@gmail.com> <post@thomasdanckaert.be>
|
||||
Tobias Geerinckx-Rice <me@tobias.gr> <tobias.geerinckx.rice@gmail.com>
|
||||
Tomáš Čech <sleep_walker@gnu.org> <sleep_walker@suse.cz>
|
||||
Tobias Geerinckx-Rice <me@tobias.gr> <tobias.geerinckx.rice@gmail.com>
|
||||
Vincent Legoll <vincent.legoll@gmail.com> <vincent.legoll@idgrilles.fr>
|
||||
|
||||
@@ -4,6 +4,7 @@
|
||||
|
||||
Copyright © 2012, 2013, 2014, 2016 Ludovic Courtès <ludo@gnu.org>
|
||||
Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org>
|
||||
Copyright © 2017 Leo Famulari <leo@famulari.name>
|
||||
|
||||
Copying and distribution of this file, with or without modification,
|
||||
are permitted in any medium without royalty provided the copyright
|
||||
@@ -43,6 +44,10 @@ configure Git to automatically sign commits, run:
|
||||
git config commit.gpgsign true
|
||||
git config user.signingkey CABBA6EA1DC0FF33
|
||||
|
||||
You can prevent yourself from accidentally pushing unsigned commits to Savannah
|
||||
by using the pre-push Git hook called 'pre-push'. It's located at
|
||||
'etc/git/pre-push'.
|
||||
|
||||
For anything else, please post to guix-devel@gnu.org and leave time for a
|
||||
review, without committing anything. If you didn’t receive any reply
|
||||
after two weeks, and if you’re confident, it’s OK to commit.
|
||||
|
||||
+15
-12
@@ -70,6 +70,7 @@ MODULES = \
|
||||
guix/build-system/haskell.scm \
|
||||
guix/build-system/perl.scm \
|
||||
guix/build-system/python.scm \
|
||||
guix/build-system/ocaml.scm \
|
||||
guix/build-system/waf.scm \
|
||||
guix/build-system/r.scm \
|
||||
guix/build-system/ruby.scm \
|
||||
@@ -95,6 +96,7 @@ MODULES = \
|
||||
guix/build/gnu-dist.scm \
|
||||
guix/build/perl-build-system.scm \
|
||||
guix/build/python-build-system.scm \
|
||||
guix/build/ocaml-build-system.scm \
|
||||
guix/build/r-build-system.scm \
|
||||
guix/build/ruby-build-system.scm \
|
||||
guix/build/waf-build-system.scm \
|
||||
@@ -122,7 +124,6 @@ MODULES = \
|
||||
guix/import/snix.scm \
|
||||
guix/import/cabal.scm \
|
||||
guix/import/cran.scm \
|
||||
guix/import/crate.scm \
|
||||
guix/import/hackage.scm \
|
||||
guix/import/elpa.scm \
|
||||
guix/scripts.scm \
|
||||
@@ -142,7 +143,6 @@ MODULES = \
|
||||
guix/scripts/lint.scm \
|
||||
guix/scripts/challenge.scm \
|
||||
guix/scripts/import/cran.scm \
|
||||
guix/scripts/import/crate.scm \
|
||||
guix/scripts/import/gnu.scm \
|
||||
guix/scripts/import/nix.scm \
|
||||
guix/scripts/import/hackage.scm \
|
||||
@@ -160,8 +160,11 @@ MODULES = \
|
||||
if HAVE_GUILE_JSON
|
||||
|
||||
MODULES += \
|
||||
guix/docker.scm \
|
||||
guix/import/github.scm \
|
||||
guix/import/json.scm \
|
||||
guix/import/crate.scm \
|
||||
guix/scripts/import/crate.scm \
|
||||
guix/import/pypi.scm \
|
||||
guix/scripts/import/pypi.scm \
|
||||
guix/import/cpan.scm \
|
||||
@@ -170,6 +173,14 @@ MODULES += \
|
||||
|
||||
endif
|
||||
|
||||
if HAVE_GUILE_SSH
|
||||
|
||||
MODULES += \
|
||||
guix/ssh.scm \
|
||||
guix/scripts/copy.scm
|
||||
|
||||
endif HAVE_GUILE_SSH
|
||||
|
||||
if BUILD_DAEMON_OFFLOAD
|
||||
|
||||
MODULES += \
|
||||
@@ -182,8 +193,8 @@ dist_noinst_DATA = guix/tests.scm guix/tests/http.scm
|
||||
|
||||
# Linux-Libre configurations.
|
||||
KCONFIGS = \
|
||||
gnu/packages/linux-libre-4.8-i686.conf \
|
||||
gnu/packages/linux-libre-4.8-x86_64.conf \
|
||||
gnu/packages/linux-libre-4.9-i686.conf \
|
||||
gnu/packages/linux-libre-4.9-x86_64.conf \
|
||||
gnu/packages/linux-libre-4.4-i686.conf \
|
||||
gnu/packages/linux-libre-4.4-x86_64.conf \
|
||||
gnu/packages/linux-libre-4.1-i686.conf \
|
||||
@@ -465,10 +476,6 @@ AM_DISTCHECK_CONFIGURE_FLAGS = \
|
||||
--with-nix-prefix="$(NIX_PREFIX)" \
|
||||
--enable-daemon
|
||||
|
||||
dist_emacsui_DATA = emacs/guix-main.scm
|
||||
nodist_emacsui_DATA = emacs/guix-helper.scm
|
||||
include emacs/local.mk
|
||||
|
||||
# The self-contained tarball.
|
||||
guix-binary.%.tar.xz:
|
||||
$(AM_V_GEN)GUIX_PACKAGE_PATH= \
|
||||
@@ -548,10 +555,6 @@ AM_V_DOT = $(AM_V_DOT_$(V))
|
||||
AM_V_DOT_ = $(AM_V_DOT_$(AM_DEFAULT_VERBOSITY))
|
||||
AM_V_DOT_0 = @echo " DOT " $@;
|
||||
|
||||
AM_V_EMACS = $(AM_V_EMACS_$(V))
|
||||
AM_V_EMACS_ = $(AM_V_EMACS_$(AM_DEFAULT_VERBOSITY))
|
||||
AM_V_EMACS_0 = @echo " EMACS " $@;
|
||||
|
||||
AM_V_HELP2MAN = $(AM_V_HELP2MAN_$(V))
|
||||
AM_V_HELP2MAN_ = $(AM_V_HELP2MAN_$(AM_DEFAULT_VERBOSITY))
|
||||
AM_V_HELP2MAN_0 = @echo " HELP2MAN" $@;
|
||||
|
||||
@@ -1,84 +0,0 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
||||
;;; under the terms of the GNU General Public License as published by
|
||||
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||
;;; your option) any later version.
|
||||
;;;
|
||||
;;; GNU Guix is distributed in the hope that it will be useful, but
|
||||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;;; GNU General Public License for more details.
|
||||
;;;
|
||||
;;; You should have received a copy of the GNU General Public License
|
||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
|
||||
;;;
|
||||
;;; This file defines an operating system configuration for the demo virtual
|
||||
;;; machine images that we build.
|
||||
;;;
|
||||
|
||||
(use-modules (gnu))
|
||||
(use-service-modules desktop xorg networking avahi dbus)
|
||||
(use-package-modules linux xorg tor avahi)
|
||||
|
||||
(operating-system
|
||||
(host-name "gnu")
|
||||
(timezone "Europe/Paris")
|
||||
(locale "en_US.utf8")
|
||||
|
||||
(bootloader (grub-configuration
|
||||
(device "/dev/sda")))
|
||||
(file-systems
|
||||
;; We provide a dummy file system for /, but that's OK because the VM build
|
||||
;; code will automatically declare the / file system for us.
|
||||
(cons* (file-system
|
||||
(mount-point "/")
|
||||
(device "dummy")
|
||||
(type "dummy"))
|
||||
;; %fuse-control-file-system ; needs fuse.ko
|
||||
;; %binary-format-file-system ; needs binfmt.ko
|
||||
%base-file-systems))
|
||||
|
||||
(users (list (user-account
|
||||
(name "guest")
|
||||
(group "users")
|
||||
(supplementary-groups '("wheel")) ; allow use of sudo
|
||||
(password "")
|
||||
(comment "Guest of GNU")
|
||||
(home-directory "/home/guest"))))
|
||||
|
||||
(issue "
|
||||
This is an alpha preview of the GNU system. Welcome.
|
||||
|
||||
This image features the GNU Guix package manager, which was used to
|
||||
build it (http://www.gnu.org/software/guix/). The init system is
|
||||
the GNU Shepherd (http://www.gnu.org/software/shepherd/).
|
||||
|
||||
You can log in as 'guest' or 'root' with no password.
|
||||
")
|
||||
|
||||
(services (cons* (slim-service #:auto-login? #t
|
||||
#:default-user "guest")
|
||||
|
||||
;; QEMU networking settings.
|
||||
(static-networking-service "eth0" "10.0.2.10"
|
||||
#:name-servers '("10.0.2.3")
|
||||
#:gateway "10.0.2.2")
|
||||
|
||||
(avahi-service)
|
||||
(dbus-service)
|
||||
(tor-service)
|
||||
|
||||
%base-services))
|
||||
(pam-services
|
||||
;; Explicitly allow for empty passwords.
|
||||
(base-pam-services #:allow-empty-passwords? #t))
|
||||
|
||||
(packages (cons* strace
|
||||
tor torsocks
|
||||
xterm avahi %base-packages)))
|
||||
@@ -125,12 +125,6 @@ SYSTEM."
|
||||
"arm-linux-gnueabihf"
|
||||
"i686-w64-mingw32"))
|
||||
|
||||
(define (demo-os)
|
||||
"Return the \"demo\" 'operating-system' structure."
|
||||
(let* ((dir (dirname (assoc-ref (current-source-location) 'filename)))
|
||||
(file (string-append dir "/demo-os.scm")))
|
||||
(read-operating-system file)))
|
||||
|
||||
(define %guixsd-supported-systems
|
||||
'("x86_64-linux" "i686-linux"))
|
||||
|
||||
@@ -156,14 +150,7 @@ system.")
|
||||
(expt 2 20))
|
||||
|
||||
(if (member system %guixsd-supported-systems)
|
||||
(list (->job 'qemu-image
|
||||
(run-with-store store
|
||||
(mbegin %store-monad
|
||||
(set-guile-for-build (default-guile))
|
||||
(system-qemu-image (demo-os)
|
||||
#:disk-image-size
|
||||
(* 1400 MiB))))) ; 1.4 GiB
|
||||
(->job 'usb-image
|
||||
(list (->job 'usb-image
|
||||
(run-with-store store
|
||||
(mbegin %store-monad
|
||||
(set-guile-for-build (default-guile))
|
||||
|
||||
+5
-10
@@ -216,6 +216,11 @@ AC_MSG_CHECKING([for zlib's shared library name])
|
||||
AC_MSG_RESULT([$LIBZ])
|
||||
AC_SUBST([LIBZ])
|
||||
|
||||
dnl Check for Guile-SSH, for the (guix ssh) module.
|
||||
GUIX_CHECK_GUILE_SSH
|
||||
AM_CONDITIONAL([HAVE_GUILE_SSH],
|
||||
[test "x$guix_cv_have_recent_guile_ssh" = "xyes"])
|
||||
|
||||
AC_CACHE_SAVE
|
||||
|
||||
m4_include([config-daemon.ac])
|
||||
@@ -237,14 +242,4 @@ AC_CONFIG_FILES([test-env:build-aux/test-env.in], [chmod +x test-env])
|
||||
AC_CONFIG_FILES([pre-inst-env:build-aux/pre-inst-env.in],
|
||||
[chmod +x pre-inst-env])
|
||||
|
||||
dnl Emacs interface.
|
||||
AC_PATH_PROG([DOT_USER_PROGRAM], [dot], [dot])
|
||||
AM_PATH_LISPDIR
|
||||
AM_CONDITIONAL([HAVE_EMACS], [test "x$EMACS" != "xno"])
|
||||
|
||||
emacsuidir="${guilemoduledir}/guix/emacs"
|
||||
AC_SUBST([emacsuidir])
|
||||
AC_CONFIG_FILES([emacs/guix-config.el
|
||||
emacs/guix-helper.scm])
|
||||
|
||||
AC_OUTPUT
|
||||
|
||||
@@ -187,9 +187,6 @@ facilities to directly operate on the syntax tree, such as raising an
|
||||
s-expression or wrapping it, swallowing or rejecting the following
|
||||
s-expression, etc.
|
||||
|
||||
GNU Guix also comes with a minor mode that provides some additional
|
||||
functionality for Scheme buffers (@pxref{Emacs Development}).
|
||||
|
||||
|
||||
@node Coding Style
|
||||
@section Coding Style
|
||||
|
||||
-881
@@ -1,881 +0,0 @@
|
||||
@node Emacs Interface
|
||||
@chapter Emacs Interface
|
||||
|
||||
@cindex Emacs
|
||||
GNU Guix comes with several useful modules (known as ``guix.el'') for
|
||||
GNU@tie{}Emacs which are intended to make an Emacs user interaction with
|
||||
Guix convenient and fun.
|
||||
|
||||
@menu
|
||||
* Initial Setup: Emacs Initial Setup. Preparing @file{~/.emacs}.
|
||||
* Package Management: Emacs Package Management. Managing packages and generations.
|
||||
* Licenses: Emacs Licenses. Interface for licenses of Guix packages.
|
||||
* Package Source Locations: Emacs Package Locations. Interface for package location files.
|
||||
* Popup Interface: Emacs Popup Interface. Magit-like interface for guix commands.
|
||||
* Prettify Mode: Emacs Prettify. Abbreviating @file{/gnu/store/@dots{}} file names.
|
||||
* Build Log Mode: Emacs Build Log. Highlighting Guix build logs.
|
||||
* Completions: Emacs Completions. Completing @command{guix} shell command.
|
||||
* Development: Emacs Development. Tools for Guix developers.
|
||||
* Hydra: Emacs Hydra. Interface for Guix build farm.
|
||||
@end menu
|
||||
|
||||
|
||||
@node Emacs Initial Setup
|
||||
@section Initial Setup
|
||||
|
||||
On the Guix System Distribution (@pxref{GNU Distribution}), ``guix.el''
|
||||
is ready to use, provided Guix is installed system-wide, which is the
|
||||
case by default. So if that is what you're using, you can happily skip
|
||||
this section and read about the fun stuff.
|
||||
|
||||
If you're not yet a happy user of GuixSD, a little bit of setup is needed.
|
||||
To be able to use ``guix.el'', you need to install the following
|
||||
packages:
|
||||
|
||||
@itemize
|
||||
@item
|
||||
@uref{http://www.gnu.org/software/emacs/, GNU Emacs}, version 24.3 or
|
||||
later;
|
||||
|
||||
@item
|
||||
@uref{http://nongnu.org/geiser/, Geiser}, version 0.3 or later: it is
|
||||
used for interacting with the Guile process.
|
||||
|
||||
@item
|
||||
@uref{https://github.com/magit/magit/, magit-popup library}. You
|
||||
already have this library if you use Magit 2.1.0 or later. This library
|
||||
is an optional dependency---it is required only for @kbd{M-x@tie{}guix}
|
||||
command (@pxref{Emacs Popup Interface}).
|
||||
|
||||
@end itemize
|
||||
|
||||
When it is done, ``guix.el'' may be configured by requiring
|
||||
@code{guix-autoloads} file. If you install Guix in your user profile,
|
||||
this auto-loading is done automatically by our Emacs package
|
||||
(@pxref{Application Setup}), so a universal recipe for configuring
|
||||
``guix.el'' is: @command{guix package -i guix}. If you do this, there
|
||||
is no need to read further.
|
||||
|
||||
For the manual installation, you need to add the following code into
|
||||
your init file (@pxref{Init File,,, emacs, The GNU Emacs Manual}):
|
||||
|
||||
@example
|
||||
(add-to-list 'load-path "/path/to/directory-with-guix.el")
|
||||
(require 'guix-autoloads nil t)
|
||||
@end example
|
||||
|
||||
So the only thing you need to figure out is where the directory with
|
||||
elisp files for Guix is placed. It depends on how you installed Guix:
|
||||
|
||||
@itemize
|
||||
@item
|
||||
If it was installed by a package manager of your distribution or by a
|
||||
usual @code{./configure && make && make install} command sequence, then
|
||||
elisp files are placed in a standard directory with Emacs packages
|
||||
(usually it is @file{/usr/share/emacs/site-lisp/}), which is already in
|
||||
@code{load-path}, so there is no need to add that directory there. Note
|
||||
that if you don't update this installation periodically, you may get an
|
||||
outdated Emacs code which does not work with the current Guile code of
|
||||
Guix.
|
||||
|
||||
@item
|
||||
If you used a binary installation method (@pxref{Binary Installation}),
|
||||
then Guix is installed somewhere in the store, so the elisp files are
|
||||
placed in @file{/gnu/store/@dots{}-guix-0.8.2/share/emacs/site-lisp/} or
|
||||
alike. However it is not recommended to refer directly to a store
|
||||
directory, as it may be garbage-collected one day. So a better choice
|
||||
would be to install Guix using Guix itself with @command{guix package -i
|
||||
guix}.
|
||||
|
||||
@item
|
||||
If you did not install Guix at all and prefer a hacking way
|
||||
(@pxref{Running Guix Before It Is Installed}), along with augmenting
|
||||
@code{load-path} you need to set @code{guix-load-path} variable to the
|
||||
same directory, so your final configuration will look like this:
|
||||
|
||||
@example
|
||||
(let ((dir "/path/to/your-guix-git-tree/emacs"))
|
||||
(add-to-list 'load-path dir)
|
||||
(setq guix-load-path dir))
|
||||
(require 'guix-autoloads nil t)
|
||||
@end example
|
||||
@end itemize
|
||||
|
||||
|
||||
@node Emacs Package Management
|
||||
@section Package Management
|
||||
|
||||
Once ``guix.el'' has been successfully configured, you should be able to
|
||||
use a visual interface for routine package management tasks, pretty much
|
||||
like the @command{guix package} command (@pxref{Invoking guix package}).
|
||||
Specifically, it makes it easy to:
|
||||
|
||||
@itemize
|
||||
@item browse and display packages and generations;
|
||||
@item search, install, upgrade and remove packages;
|
||||
@item display packages from previous generations;
|
||||
@item do some other useful things.
|
||||
@end itemize
|
||||
|
||||
@menu
|
||||
* Commands: Emacs Commands. @kbd{M-x guix-@dots{}}
|
||||
* General information: Emacs General info. Common for both interfaces.
|
||||
* ``List'' buffer: Emacs List buffer. List-like interface.
|
||||
* ``Info'' buffer: Emacs Info buffer. Help-like interface.
|
||||
* Configuration: Emacs Configuration. Configuring the interface.
|
||||
@end menu
|
||||
|
||||
@node Emacs Commands
|
||||
@subsection Commands
|
||||
|
||||
All commands for displaying packages and generations use the current
|
||||
profile, which can be changed with
|
||||
@kbd{M-x@tie{}guix-set-current-profile}. Alternatively, if you call any
|
||||
of these commands with prefix argument (@kbd{C-u}), you will be prompted
|
||||
for a profile just for that command.
|
||||
|
||||
Commands for displaying packages:
|
||||
|
||||
@table @kbd
|
||||
|
||||
@item M-x guix-all-available-packages
|
||||
@itemx M-x guix-newest-available-packages
|
||||
Display all/newest available packages.
|
||||
|
||||
@item M-x guix-installed-packages
|
||||
@itemx M-x guix-installed-user-packages
|
||||
@itemx M-x guix-installed-system-packages
|
||||
Display installed packages. As described above, @kbd{M-x
|
||||
guix-installed-packages} uses an arbitrary profile that you can specify,
|
||||
while the other commands display packages installed in 2 special
|
||||
profiles: @file{~/.guix-profile} and @file{/run/current-system/profile}
|
||||
(only on GuixSD).
|
||||
|
||||
@item M-x guix-obsolete-packages
|
||||
Display obsolete packages (the packages that are installed in a profile
|
||||
but cannot be found among available packages).
|
||||
|
||||
@item M-x guix-packages-by-name
|
||||
Display package(s) with the specified name.
|
||||
|
||||
@item M-x guix-packages-by-license
|
||||
Display package(s) with the specified license.
|
||||
|
||||
@item M-x guix-packages-by-location
|
||||
Display package(s) located in the specified file. These files usually
|
||||
have the following form: @file{gnu/packages/emacs.scm}, but don't type
|
||||
them manually! Press @key{TAB} to complete the file name.
|
||||
|
||||
@item M-x guix-package-from-file
|
||||
Display package that the code within the specified file evaluates to.
|
||||
@xref{Invoking guix package, @code{--install-from-file}}, for an example
|
||||
of what such a file may look like.
|
||||
|
||||
@item M-x guix-search-by-regexp
|
||||
Search for packages by a specified regexp. By default ``name'',
|
||||
``synopsis'' and ``description'' of the packages will be searched. This
|
||||
can be changed by modifying @code{guix-package-search-params} variable.
|
||||
|
||||
@item M-x guix-search-by-name
|
||||
Search for packages with names matching a specified regexp. This
|
||||
command is the same as @code{guix-search-by-regexp}, except only a
|
||||
package ``name'' is searched.
|
||||
|
||||
@end table
|
||||
|
||||
By default, these commands display each output on a separate line. If
|
||||
you prefer to see a list of packages---i.e., a list with a package per
|
||||
line, use the following setting:
|
||||
|
||||
@example
|
||||
(setq guix-package-list-type 'package)
|
||||
@end example
|
||||
|
||||
Commands for displaying generations:
|
||||
|
||||
@table @kbd
|
||||
|
||||
@item M-x guix-generations
|
||||
List all the generations.
|
||||
|
||||
@item M-x guix-last-generations
|
||||
List the @var{N} last generations. You will be prompted for the number
|
||||
of generations.
|
||||
|
||||
@item M-x guix-generations-by-time
|
||||
List generations matching time period. You will be prompted for the
|
||||
period using Org mode time prompt based on Emacs calendar (@pxref{The
|
||||
date/time prompt,,, org, The Org Manual}).
|
||||
|
||||
@end table
|
||||
|
||||
Analogously on GuixSD you can also display system generations:
|
||||
|
||||
@table @kbd
|
||||
@item M-x guix-system-generations
|
||||
@item M-x guix-last-system-generations
|
||||
@item M-x guix-system-generations-by-time
|
||||
@end table
|
||||
|
||||
You can also invoke the @command{guix pull} command (@pxref{Invoking
|
||||
guix pull}) from Emacs using:
|
||||
|
||||
@table @kbd
|
||||
@item M-x guix-pull
|
||||
With @kbd{C-u}, make it verbose.
|
||||
@end table
|
||||
|
||||
Once @command{guix pull} has succeeded, the Guix REPL is restarted. This
|
||||
allows you to keep using the Emacs interface with the updated Guix.
|
||||
|
||||
|
||||
@node Emacs General info
|
||||
@subsection General information
|
||||
|
||||
The following keys are available for both ``list'' and ``info'' types of
|
||||
buffers:
|
||||
|
||||
@table @kbd
|
||||
@item l
|
||||
@itemx r
|
||||
Go backward/forward by the history of the displayed results (this
|
||||
history is similar to the history of the Emacs @code{help-mode} or
|
||||
@code{Info-mode}).
|
||||
|
||||
@item g
|
||||
Revert current buffer: update information about the displayed
|
||||
packages/generations and redisplay it.
|
||||
|
||||
@item R
|
||||
Redisplay current buffer (without updating information).
|
||||
|
||||
@item M
|
||||
Apply manifest to the current profile or to a specified profile, if
|
||||
prefix argument is used. This has the same meaning as @code{--manifest}
|
||||
option (@pxref{Invoking guix package}).
|
||||
|
||||
@item C-c C-z
|
||||
@cindex REPL
|
||||
@cindex read-eval-print loop
|
||||
Go to the Guix REPL (@pxref{The REPL,,, geiser, Geiser User Manual}).
|
||||
|
||||
@item h
|
||||
@itemx ?
|
||||
Describe current mode to see all available bindings.
|
||||
|
||||
@end table
|
||||
|
||||
@emph{Hint:} If you need several ``list'' or ``info'' buffers, you can
|
||||
simply @kbd{M-x clone-buffer} them, and each buffer will have its own
|
||||
history.
|
||||
|
||||
@emph{Warning:} Name/version pairs cannot be used to identify packages
|
||||
(because a name is not necessarily unique), so ``guix.el'' uses special
|
||||
identifiers that live only during a guile session, so if the Guix REPL
|
||||
was restarted, you may want to revert ``list'' buffer (by pressing
|
||||
@kbd{g}).
|
||||
|
||||
@node Emacs List buffer
|
||||
@subsection ``List'' buffer
|
||||
|
||||
An interface of a ``list'' buffer is similar to the interface provided
|
||||
by ``package.el'' (@pxref{Package Menu,,, emacs, The GNU Emacs Manual}).
|
||||
|
||||
Default key bindings available for both ``package-list'' and
|
||||
``generation-list'' buffers:
|
||||
|
||||
@table @kbd
|
||||
@item m
|
||||
Mark the current entry (with prefix, mark all entries).
|
||||
@item u
|
||||
Unmark the current entry (with prefix, unmark all entries).
|
||||
@item @key{DEL}
|
||||
Unmark backward.
|
||||
@item S
|
||||
Sort entries by a specified column.
|
||||
@end table
|
||||
|
||||
A ``package-list'' buffer additionally provides the following bindings:
|
||||
|
||||
@table @kbd
|
||||
@item @key{RET}
|
||||
Describe marked packages (display available information in a
|
||||
``package-info'' buffer).
|
||||
@item i
|
||||
Mark the current package for installation.
|
||||
@item d
|
||||
Mark the current package for deletion.
|
||||
@item U
|
||||
Mark the current package for upgrading.
|
||||
@item ^
|
||||
Mark all obsolete packages for upgrading.
|
||||
@item e
|
||||
Edit the definition of the current package (go to its location). This is
|
||||
similar to @command{guix edit} command (@pxref{Invoking guix edit}), but
|
||||
for opening a package recipe in the current Emacs instance.
|
||||
@item x
|
||||
Execute actions on the marked packages.
|
||||
@item B
|
||||
Display latest builds of the current package (@pxref{Emacs Hydra}).
|
||||
@end table
|
||||
|
||||
A ``generation-list'' buffer additionally provides the following
|
||||
bindings:
|
||||
|
||||
@table @kbd
|
||||
@item @key{RET}
|
||||
List packages installed in the current generation.
|
||||
@item i
|
||||
Describe marked generations (display available information in a
|
||||
``generation-info'' buffer).
|
||||
@item s
|
||||
Switch profile to the current generation.
|
||||
@item d
|
||||
Mark the current generation for deletion (with prefix, mark all
|
||||
generations).
|
||||
@item x
|
||||
Execute actions on the marked generations---i.e., delete generations.
|
||||
@item e
|
||||
Run Ediff (@pxref{Top,,, ediff, The Ediff Manual}) on package outputs
|
||||
installed in the 2 marked generations. With prefix argument, run Ediff
|
||||
on manifests of the marked generations.
|
||||
@item D
|
||||
@itemx =
|
||||
Run Diff (@pxref{Diff Mode,,, emacs, The GNU Emacs Manual}) on package
|
||||
outputs installed in the 2 marked generations. With prefix argument,
|
||||
run Diff on manifests of the marked generations.
|
||||
@item +
|
||||
List package outputs added to the latest marked generation comparing
|
||||
with another marked generation.
|
||||
@item -
|
||||
List package outputs removed from the latest marked generation comparing
|
||||
with another marked generation.
|
||||
@end table
|
||||
|
||||
@node Emacs Info buffer
|
||||
@subsection ``Info'' buffer
|
||||
|
||||
The interface of an ``info'' buffer is similar to the interface of
|
||||
@code{help-mode} (@pxref{Help Mode,,, emacs, The GNU Emacs Manual}).
|
||||
|
||||
``Info'' buffer contains some buttons (as usual you may use @key{TAB} /
|
||||
@kbd{S-@key{TAB}} to move between buttons---@pxref{Mouse References,,,
|
||||
emacs, The GNU Emacs Manual}) which can be used to:
|
||||
|
||||
@itemize @bullet
|
||||
@item (in a ``package-info'' buffer)
|
||||
|
||||
@itemize @minus
|
||||
@item install/remove a package;
|
||||
@item jump to a package location;
|
||||
@item browse home page of a package;
|
||||
@item browse license URL;
|
||||
@item describe packages from ``Inputs'' fields.
|
||||
@end itemize
|
||||
|
||||
@item (in a ``generation-info'' buffer)
|
||||
|
||||
@itemize @minus
|
||||
@item remove a generation;
|
||||
@item switch to a generation;
|
||||
@item list packages installed in a generation;
|
||||
@item jump to a generation directory.
|
||||
@end itemize
|
||||
|
||||
@end itemize
|
||||
|
||||
It is also possible to copy a button label (a link to an URL or a file)
|
||||
by pressing @kbd{c} on a button.
|
||||
|
||||
|
||||
@node Emacs Configuration
|
||||
@subsection Configuration
|
||||
|
||||
There are many variables you can modify to change the appearance or
|
||||
behavior of Emacs user interface. Some of these variables are described
|
||||
in this section. Also you can use Custom Interface (@pxref{Easy
|
||||
Customization,,, emacs, The GNU Emacs Manual}) to explore/set variables
|
||||
(not all) and faces.
|
||||
|
||||
@menu
|
||||
* Guile and Build Options: Emacs Build Options. Specifying how packages are built.
|
||||
* Buffer Names: Emacs Buffer Names. Names of Guix buffers.
|
||||
* Keymaps: Emacs Keymaps. Configuring key bindings.
|
||||
* Appearance: Emacs Appearance. Settings for visual appearance.
|
||||
@end menu
|
||||
|
||||
@node Emacs Build Options
|
||||
@subsubsection Guile and Build Options
|
||||
|
||||
@table @code
|
||||
@item guix-guile-program
|
||||
If you have some special needs for starting a Guile process, you may set
|
||||
this variable, for example:
|
||||
|
||||
@example
|
||||
(setq guix-guile-program '("/bin/guile" "--no-auto-compile"))
|
||||
@end example
|
||||
|
||||
@item guix-use-substitutes
|
||||
If nil, has the same meaning as @code{--no-substitutes} option
|
||||
(@pxref{Invoking guix build}).
|
||||
|
||||
@item guix-dry-run
|
||||
If non-nil, has the same meaning as @code{--dry-run} option
|
||||
(@pxref{Invoking guix build}).
|
||||
|
||||
@end table
|
||||
|
||||
@node Emacs Buffer Names
|
||||
@subsubsection Buffer Names
|
||||
|
||||
Default names of ``guix.el'' buffers (``*Guix@tie{}@dots{}*'') may be
|
||||
changed with the following variables:
|
||||
|
||||
@table @code
|
||||
@item guix-package-list-buffer-name
|
||||
@item guix-output-list-buffer-name
|
||||
@item guix-generation-list-buffer-name
|
||||
@item guix-package-info-buffer-name
|
||||
@item guix-output-info-buffer-name
|
||||
@item guix-generation-info-buffer-name
|
||||
@item guix-repl-buffer-name
|
||||
@item guix-internal-repl-buffer-name
|
||||
@end table
|
||||
|
||||
By default, the name of a profile is also displayed in a ``list'' or
|
||||
``info'' buffer name. To change this behavior, use
|
||||
@code{guix-ui-buffer-name-function} variable.
|
||||
|
||||
For example, if you want to display all types of results in a single
|
||||
buffer (in such case you will probably use a history (@kbd{l}/@kbd{r})
|
||||
extensively), you may do it like this:
|
||||
|
||||
@example
|
||||
(let ((name "Guix Universal"))
|
||||
(setq
|
||||
guix-package-list-buffer-name name
|
||||
guix-output-list-buffer-name name
|
||||
guix-generation-list-buffer-name name
|
||||
guix-package-info-buffer-name name
|
||||
guix-output-info-buffer-name name
|
||||
guix-generation-info-buffer-name name))
|
||||
@end example
|
||||
|
||||
@node Emacs Keymaps
|
||||
@subsubsection Keymaps
|
||||
|
||||
If you want to change default key bindings, use the following keymaps
|
||||
(@pxref{Init Rebinding,,, emacs, The GNU Emacs Manual}):
|
||||
|
||||
@table @code
|
||||
@item guix-buffer-map
|
||||
Parent keymap with general keys for any buffer type.
|
||||
|
||||
@item guix-ui-map
|
||||
Parent keymap with general keys for buffers used for Guix package
|
||||
management (for packages, outputs and generations).
|
||||
|
||||
@item guix-list-mode-map
|
||||
Parent keymap with general keys for ``list'' buffers.
|
||||
|
||||
@item guix-package-list-mode-map
|
||||
Keymap with specific keys for ``package-list'' buffers.
|
||||
|
||||
@item guix-output-list-mode-map
|
||||
Keymap with specific keys for ``output-list'' buffers.
|
||||
|
||||
@item guix-generation-list-mode-map
|
||||
Keymap with specific keys for ``generation-list'' buffers.
|
||||
|
||||
@item guix-info-mode-map
|
||||
Parent keymap with general keys for ``info'' buffers.
|
||||
|
||||
@item guix-package-info-mode-map
|
||||
Keymap with specific keys for ``package-info'' buffers.
|
||||
|
||||
@item guix-output-info-mode-map
|
||||
Keymap with specific keys for ``output-info'' buffers.
|
||||
|
||||
@item guix-generation-info-mode-map
|
||||
Keymap with specific keys for ``generation-info'' buffers.
|
||||
|
||||
@item guix-info-button-map
|
||||
Keymap with keys available when a point is placed on a button.
|
||||
|
||||
@end table
|
||||
|
||||
@node Emacs Appearance
|
||||
@subsubsection Appearance
|
||||
|
||||
You can change almost any aspect of ``list'' / ``info'' buffers using
|
||||
the following variables (@dfn{ENTRY-TYPE} means @code{package},
|
||||
@code{output} or @code{generation}):
|
||||
|
||||
@table @code
|
||||
@item guix-ENTRY-TYPE-list-format
|
||||
@itemx guix-ENTRY-TYPE-list-titles
|
||||
Specify the columns, their names, what and how is displayed in ``list''
|
||||
buffers.
|
||||
|
||||
@item guix-ENTRY-TYPE-info-format
|
||||
@itemx guix-ENTRY-TYPE-info-titles
|
||||
@itemx guix-info-ignore-empty-values
|
||||
@itemx guix-info-param-title-format
|
||||
@itemx guix-info-multiline-prefix
|
||||
@itemx guix-info-indent
|
||||
@itemx guix-info-fill
|
||||
@itemx guix-info-delimiter
|
||||
Various settings for ``info'' buffers.
|
||||
|
||||
@end table
|
||||
|
||||
|
||||
@node Emacs Licenses
|
||||
@section Licenses
|
||||
|
||||
If you want to browse the URL of a particular license, or to look at a
|
||||
list of licenses, you may use the following commands:
|
||||
|
||||
@table @kbd
|
||||
|
||||
@item M-x guix-browse-license-url
|
||||
Choose a license from a completion list to browse its URL using
|
||||
@code{browse-url} function (@pxref{Browse-URL,,, emacs, The GNU Emacs
|
||||
Manual}).
|
||||
|
||||
@item M-x guix-licenses
|
||||
Display a list of available licenses. You can press @kbd{@key{RET}}
|
||||
there to display packages with this license in the same way as @kbd{M-x
|
||||
guix-packages-by-license} would do (@pxref{Emacs Commands}).
|
||||
|
||||
@item M-x guix-find-license-definition
|
||||
Open @file{@dots{}/guix/licenses.scm} and move to the specified license.
|
||||
|
||||
@end table
|
||||
|
||||
|
||||
@node Emacs Package Locations
|
||||
@section Package Source Locations
|
||||
|
||||
As you know, package definitions are placed in Guile files, also known
|
||||
as @dfn{package locations}. The following commands should help you not
|
||||
get lost in these locations:
|
||||
|
||||
@table @kbd
|
||||
|
||||
@item M-x guix-locations
|
||||
Display a list of package locations. You can press @key{RET} there to
|
||||
display packages placed in the current location in the same way as
|
||||
@kbd{M-x guix-packages-by-location} would do (@pxref{Emacs Commands}).
|
||||
Note that when the point is on a location button, @key{RET} will open
|
||||
this location file.
|
||||
|
||||
@item M-x guix-find-location
|
||||
Open the given package definition source file (press @key{TAB} to choose
|
||||
a location from a completion list).
|
||||
|
||||
@item M-x guix-edit
|
||||
Find location of a specified package. This is an Emacs analog of
|
||||
@command{guix edit} command (@pxref{Invoking guix edit}). As with
|
||||
@kbd{M-x guix-packages-by-name}, you can press @key{TAB} to complete a
|
||||
package name.
|
||||
|
||||
@end table
|
||||
|
||||
If you are contributing to Guix, you may find it useful for @kbd{M-x
|
||||
guix-find-location} and @kbd{M-x guix-edit} to open locations from your
|
||||
Git checkout. This can be done by setting @code{guix-directory}
|
||||
variable. For example, after this:
|
||||
|
||||
@example
|
||||
(setq guix-directory "~/src/guix")
|
||||
@end example
|
||||
|
||||
@kbd{M-x guix-edit guix} opens
|
||||
@file{~/src/guix/gnu/packages/package-management.scm} file.
|
||||
|
||||
Also you can use @kbd{C-u} prefix argument to specify a directory just
|
||||
for the current @kbd{M-x guix-find-location} or @kbd{M-x guix-edit}
|
||||
command.
|
||||
|
||||
|
||||
@node Emacs Popup Interface
|
||||
@section Popup Interface
|
||||
|
||||
If you ever used Magit, you know what ``popup interface'' is
|
||||
(@pxref{Top,,, magit-popup, Magit-Popup User Manual}). Even if you are
|
||||
not acquainted with Magit, there should be no worries as it is very
|
||||
intuitive.
|
||||
|
||||
So @kbd{M-x@tie{}guix} command provides a top-level popup interface for
|
||||
all available guix commands. When you select an option, you'll be
|
||||
prompted for a value in the minibuffer. Many values have completions,
|
||||
so don't hesitate to press @key{TAB} key. Multiple values (for example,
|
||||
packages or lint checkers) should be separated by commas.
|
||||
|
||||
After specifying all options and switches for a command, you may choose
|
||||
one of the available actions. The following default actions are
|
||||
available for all commands:
|
||||
|
||||
@itemize
|
||||
|
||||
@item
|
||||
Run the command in the Guix REPL. It is faster than running
|
||||
@code{guix@tie{}@dots{}} command directly in shell, as there is no
|
||||
need to run another guile process and to load required modules there.
|
||||
|
||||
@item
|
||||
Run the command in a shell buffer. You can set
|
||||
@code{guix-run-in-shell-function} variable to fine tune the shell buffer
|
||||
you want to use.
|
||||
|
||||
@item
|
||||
Add the command line to the kill ring (@pxref{Kill Ring,,, emacs, The
|
||||
GNU Emacs Manual}).
|
||||
|
||||
@end itemize
|
||||
|
||||
Several commands (@command{guix graph}, @command{guix system shepherd-graph}
|
||||
and @command{guix system extension-graph}) also have a ``View graph''
|
||||
action, which allows you to view a generated graph using @command{dot}
|
||||
command (specified by @code{guix-dot-program} variable). By default a
|
||||
PNG file will be saved in @file{/tmp} directory and will be opened
|
||||
directly in Emacs. This behavior may be changed with the following
|
||||
variables:
|
||||
|
||||
@table @code
|
||||
|
||||
@item guix-find-file-function
|
||||
Function used to open a generated graph. If you want to open a graph in
|
||||
an external program, you can do it by modifying this variable---for
|
||||
example, you can use a functionality provided by the Org Mode
|
||||
(@pxref{Top,,, org, The Org Manual}):
|
||||
|
||||
@example
|
||||
(setq guix-find-file-function 'org-open-file)
|
||||
(add-to-list 'org-file-apps '("\\.png\\'" . "sxiv %s"))
|
||||
@end example
|
||||
|
||||
@item guix-dot-default-arguments
|
||||
Command line arguments to run @command{dot} command. If you change an
|
||||
output format (for example, into @code{-Tpdf}), you also need to change
|
||||
the next variable.
|
||||
|
||||
@item guix-dot-file-name-function
|
||||
Function used to define a name of the generated graph file. Default
|
||||
name is @file{/tmp/guix-emacs-graph-XXXXXX.png}.
|
||||
|
||||
@end table
|
||||
|
||||
So, for example, if you want to generate and open a PDF file in your
|
||||
Emacs, you may change the settings like this:
|
||||
|
||||
@example
|
||||
(defun my-guix-pdf-graph ()
|
||||
"/tmp/my-current-guix-graph.pdf")
|
||||
|
||||
(setq guix-dot-default-arguments '("-Tpdf")
|
||||
guix-dot-file-name-function 'my-guix-pdf-graph)
|
||||
@end example
|
||||
|
||||
|
||||
@node Emacs Prettify
|
||||
@section Guix Prettify Mode
|
||||
|
||||
GNU@tie{}Guix also comes with ``guix-prettify.el''. It provides a minor
|
||||
mode for abbreviating store file names by replacing hash sequences of
|
||||
symbols with ``@dots{}'':
|
||||
|
||||
@example
|
||||
/gnu/store/72f54nfp6g1hz873w8z3gfcah0h4nl9p-foo-0.1
|
||||
@result{} /gnu/store/…-foo-0.1
|
||||
@end example
|
||||
|
||||
Once you set up ``guix.el'' (@pxref{Emacs Initial Setup}), the following
|
||||
commands become available:
|
||||
|
||||
@table @kbd
|
||||
|
||||
@item M-x guix-prettify-mode
|
||||
Enable/disable prettifying for the current buffer.
|
||||
|
||||
@item M-x global-guix-prettify-mode
|
||||
Enable/disable prettifying globally.
|
||||
|
||||
@end table
|
||||
|
||||
To automatically enable @code{guix-prettify-mode} globally on Emacs
|
||||
start, add the following line to your init file:
|
||||
|
||||
@example
|
||||
(global-guix-prettify-mode)
|
||||
@end example
|
||||
|
||||
If you want to enable it only for specific major modes, add it to the
|
||||
mode hooks (@pxref{Hooks,,, emacs, The GNU Emacs Manual}), for example:
|
||||
|
||||
@example
|
||||
(add-hook 'shell-mode-hook 'guix-prettify-mode)
|
||||
(add-hook 'dired-mode-hook 'guix-prettify-mode)
|
||||
@end example
|
||||
|
||||
|
||||
@node Emacs Build Log
|
||||
@section Build Log Mode
|
||||
|
||||
GNU@tie{}Guix provides major and minor modes for highlighting build
|
||||
logs. So when you have a file with a package build output---for
|
||||
example, a file returned by @command{guix build --log-file @dots{}}
|
||||
command (@pxref{Invoking guix build}), you may call @kbd{M-x
|
||||
guix-build-log-mode} command in the buffer with this file. This major
|
||||
mode highlights some lines specific to build output and provides the
|
||||
following key bindings:
|
||||
|
||||
@table @kbd
|
||||
|
||||
@item M-n
|
||||
Move to the next build phase.
|
||||
|
||||
@item M-p
|
||||
Move to the previous build phase.
|
||||
|
||||
@item @key{TAB}
|
||||
Toggle (show/hide) the body of the current build phase.
|
||||
|
||||
@item S-@key{TAB}
|
||||
Toggle (show/hide) the bodies of all build phases.
|
||||
|
||||
@end table
|
||||
|
||||
There is also @kbd{M-x guix-build-log-minor-mode} which also provides
|
||||
the same highlighting and the same key bindings as the major mode, but
|
||||
prefixed with @kbd{C-c}. By default, this minor mode is enabled in
|
||||
shell buffers (@pxref{Interactive Shell,,, emacs, The GNU Emacs
|
||||
Manual}). If you don't like it, set
|
||||
@code{guix-build-log-minor-mode-activate} to nil.
|
||||
|
||||
|
||||
@node Emacs Completions
|
||||
@section Shell Completions
|
||||
|
||||
Another feature that becomes available after configuring Emacs interface
|
||||
(@pxref{Emacs Initial Setup}) is completing of @command{guix}
|
||||
subcommands, options, packages and other things in @code{shell}
|
||||
(@pxref{Interactive Shell,,, emacs, The GNU Emacs Manual}) and
|
||||
@code{eshell} (@pxref{Top,,, eshell, Eshell: The Emacs Shell}).
|
||||
|
||||
It works the same way as other completions do. Just press @key{TAB}
|
||||
when your intuition tells you.
|
||||
|
||||
And here are some examples, where pressing @key{TAB} may complete
|
||||
something:
|
||||
|
||||
@itemize @w{}
|
||||
|
||||
@item @code{guix pa}@key{TAB}
|
||||
@item @code{guix package -}@key{TAB}
|
||||
@item @code{guix package --}@key{TAB}
|
||||
@item @code{guix package -i gei}@key{TAB}
|
||||
@item @code{guix build -L/tm}@key{TAB}
|
||||
@item @code{guix build --sy}@key{TAB}
|
||||
@item @code{guix build --system=i}@key{TAB}
|
||||
@item @code{guix system rec}@key{TAB}
|
||||
@item @code{guix lint --checkers=sy}@key{TAB}
|
||||
@item @code{guix lint --checkers=synopsis,des}@key{TAB}
|
||||
|
||||
@end itemize
|
||||
|
||||
|
||||
@node Emacs Development
|
||||
@section Development
|
||||
|
||||
By default, when you open a Scheme file, @code{guix-devel-mode} will be
|
||||
activated (if you don't want it, set @code{guix-devel-activate-mode} to
|
||||
nil). This minor mode provides the following key bindings:
|
||||
|
||||
@table @kbd
|
||||
|
||||
@item C-c . k
|
||||
Copy the name of the current Guile module into kill ring
|
||||
(@code{guix-devel-copy-module-as-kill}).
|
||||
|
||||
@item C-c . u
|
||||
Use the current Guile module. Often after opening a Scheme file, you
|
||||
want to use a module it defines, so you switch to the Geiser REPL and
|
||||
write @code{,use (some module)} there. You may just use this command
|
||||
instead (@code{guix-devel-use-module}).
|
||||
|
||||
@item C-c . b
|
||||
Build a package defined by the current variable definition. The
|
||||
building process is run in the current Geiser REPL. If you modified the
|
||||
current package definition, don't forget to reevaluate it before calling
|
||||
this command---for example, with @kbd{C-M-x} (@pxref{To eval or not to
|
||||
eval,,, geiser, Geiser User Manual})
|
||||
(@code{guix-devel-build-package-definition}).
|
||||
|
||||
@item C-c . s
|
||||
Build a source derivation of the package defined by the current variable
|
||||
definition. This command has the same meaning as @code{guix build -S}
|
||||
shell command (@pxref{Invoking guix build})
|
||||
(@code{guix-devel-build-package-source}).
|
||||
|
||||
@item C-c . l
|
||||
Lint (check) a package defined by the current variable definition
|
||||
(@pxref{Invoking guix lint}) (@code{guix-devel-lint-package}).
|
||||
|
||||
@end table
|
||||
|
||||
Unluckily, there is a limitation related to long-running REPL commands.
|
||||
When there is a running process in a Geiser REPL, you are not supposed
|
||||
to evaluate anything in a scheme buffer, because this will ``freeze''
|
||||
the REPL: it will stop producing any output (however, the evaluating
|
||||
process will continue---you will just not see any progress anymore). Be
|
||||
aware: even moving the point in a scheme buffer may ``break'' the REPL
|
||||
if Autodoc (@pxref{Autodoc and friends,,, geiser, Geiser User Manual})
|
||||
is enabled (which is the default).
|
||||
|
||||
So you have to postpone editing your scheme buffers until the running
|
||||
evaluation will be finished in the REPL.
|
||||
|
||||
Alternatively, to avoid this limitation, you may just run another Geiser
|
||||
REPL, and while something is being evaluated in the previous REPL, you
|
||||
can continue editing a scheme file with the help of the current one.
|
||||
|
||||
|
||||
@node Emacs Hydra
|
||||
@section Hydra
|
||||
|
||||
The continuous integration server at @code{hydra.gnu.org} builds all
|
||||
the distribution packages on the supported architectures and serves
|
||||
them as substitutes (@pxref{Substitutes}). Continuous integration is
|
||||
currently orchestrated by @uref{https://nixos.org/hydra/, Hydra}.
|
||||
|
||||
This section describes an Emacs interface to query Hydra to know the
|
||||
build status of specific packages, discover recent and ongoing builds,
|
||||
view build logs, and so on. This interface is mostly the same as the
|
||||
``list''/``info'' interface for displaying packages and generations
|
||||
(@pxref{Emacs Package Management}).
|
||||
|
||||
The following commands are available:
|
||||
|
||||
@table @kbd
|
||||
|
||||
@item M-x guix-hydra-latest-builds
|
||||
Display latest failed or successful builds (you will be prompted for a
|
||||
number of builds). With @kbd{C-u}, you will also be prompted for other
|
||||
parameters (project, jobset, job and system).
|
||||
|
||||
@item M-x guix-hydra-queued-builds
|
||||
Display scheduled or currently running builds (you will be prompted for
|
||||
a number of builds).
|
||||
|
||||
@item M-x guix-hydra-jobsets
|
||||
Display available jobsets (you will be prompted for a project).
|
||||
|
||||
@end table
|
||||
|
||||
In a list of builds you can press @kbd{L} key to display a build log of
|
||||
the current build. Also both a list of builds and a list of jobsets
|
||||
provide @kbd{B} key to display latest builds of the current job or
|
||||
jobset (don't forget about @kbd{C-u}).
|
||||
+586
-89
@@ -13,7 +13,7 @@
|
||||
@set OPENPGP-SIGNING-KEY-ID BCA689B636553801C3C62150197A5888235FACAC
|
||||
|
||||
@copying
|
||||
Copyright @copyright{} 2012, 2013, 2014, 2015, 2016 Ludovic Courtès@*
|
||||
Copyright @copyright{} 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès@*
|
||||
Copyright @copyright{} 2013, 2014, 2016 Andreas Enge@*
|
||||
Copyright @copyright{} 2013 Nikita Karetnikov@*
|
||||
Copyright @copyright{} 2014, 2015, 2016 Alex Kost@*
|
||||
@@ -29,7 +29,8 @@ Copyright @copyright{} 2016 John Darrington@*
|
||||
Copyright @copyright{} 2016 ng0@*
|
||||
Copyright @copyright{} 2016 Jan Nieuwenhuizen@*
|
||||
Copyright @copyright{} 2016 Julien Lepiller@*
|
||||
Copyright @copyright{} 2016 Alex ter Weele
|
||||
Copyright @copyright{} 2016 Alex ter Weele@*
|
||||
Copyright @copyright{} 2017 Clément Lassieur
|
||||
|
||||
Permission is granted to copy, distribute and/or modify this document
|
||||
under the terms of the GNU Free Documentation License, Version 1.3 or
|
||||
@@ -54,12 +55,6 @@ Documentation License''.
|
||||
* guix environment: (guix)Invoking guix environment. Building development environments with Guix.
|
||||
@end direntry
|
||||
|
||||
@dircategory Emacs
|
||||
@direntry
|
||||
* Guix user interface: (guix)Emacs Interface. Package management from the comfort of Emacs.
|
||||
@end direntry
|
||||
|
||||
|
||||
@titlepage
|
||||
@title GNU Guix Reference Manual
|
||||
@subtitle Using the GNU Guix Functional Package Manager
|
||||
@@ -86,7 +81,6 @@ package management tool written for the GNU system.
|
||||
* Introduction:: What is Guix about?
|
||||
* Installation:: Installing Guix.
|
||||
* Package Management:: Package installation, upgrade, etc.
|
||||
* Emacs Interface:: Using Guix from Emacs.
|
||||
* Programming Interface:: Using Guix in Scheme.
|
||||
* Utilities:: Package management commands.
|
||||
* GNU Distribution:: Software for your friendly GNU system.
|
||||
@@ -124,19 +118,6 @@ Package Management
|
||||
* Invoking guix pull:: Fetching the latest Guix and distribution.
|
||||
* Invoking guix archive:: Exporting and importing store files.
|
||||
|
||||
Emacs Interface
|
||||
|
||||
* Initial Setup: Emacs Initial Setup. Preparing @file{~/.emacs}.
|
||||
* Package Management: Emacs Package Management. Managing packages and generations.
|
||||
* Licenses: Emacs Licenses. Interface for licenses of Guix packages.
|
||||
* Package Source Locations: Emacs Package Locations. Interface for package location files.
|
||||
* Popup Interface: Emacs Popup Interface. Magit-like interface for guix commands.
|
||||
* Prettify Mode: Emacs Prettify. Abbreviating @file{/gnu/store/@dots{}} file names.
|
||||
* Build Log Mode: Emacs Build Log. Highlighting Guix build logs.
|
||||
* Completions: Emacs Completions. Completing @command{guix} shell command.
|
||||
* Development: Emacs Development. Tools for Guix developers.
|
||||
* Hydra: Emacs Hydra. Interface for Guix build farm.
|
||||
|
||||
Programming Interface
|
||||
|
||||
* Defining Packages:: Defining new packages.
|
||||
@@ -165,12 +146,13 @@ Utilities
|
||||
* Invoking guix environment:: Setting up development environments.
|
||||
* Invoking guix publish:: Sharing substitutes.
|
||||
* Invoking guix challenge:: Challenging substitute servers.
|
||||
* Invoking guix copy:: Copying to and from a remote store.
|
||||
* Invoking guix container:: Process isolation.
|
||||
|
||||
Invoking @command{guix build}
|
||||
|
||||
* Common Build Options:: Build options for most commands.
|
||||
* Package Transformation Options:: Creating variants of packages.
|
||||
* Package Transformation Options:: Creating variants of packages.
|
||||
* Additional Build Options:: Options specific to 'guix build'.
|
||||
|
||||
GNU Distribution
|
||||
@@ -219,12 +201,15 @@ Services
|
||||
* Log Rotation:: The rottlog service.
|
||||
* Networking Services:: Network setup, SSH daemon, etc.
|
||||
* X Window:: Graphical display.
|
||||
* Printing Services:: Local and remote printer support.
|
||||
* Desktop Services:: D-Bus and desktop services.
|
||||
* Database Services:: SQL databases.
|
||||
* Mail Services:: IMAP, POP3, SMTP, and all that.
|
||||
* Messaging Services:: Messaging services.
|
||||
* Kerberos Services:: Kerberos services.
|
||||
* Web Services:: Web servers.
|
||||
* Network File System:: NFS related services.
|
||||
* Continuous Integration:: The Cuirass service.
|
||||
* Miscellaneous Services:: Other services.
|
||||
|
||||
Defining Services
|
||||
@@ -278,8 +263,7 @@ assists with the creation and maintenance of software environments.
|
||||
@cindex user interfaces
|
||||
Guix provides a command-line package management interface
|
||||
(@pxref{Invoking guix package}), a set of command-line utilities
|
||||
(@pxref{Utilities}), a visual user interface in Emacs (@pxref{Emacs
|
||||
Interface}), as well as Scheme programming interfaces
|
||||
(@pxref{Utilities}), as well as Scheme programming interfaces
|
||||
(@pxref{Programming Interface}).
|
||||
@cindex build daemon
|
||||
Its @dfn{build daemon} is responsible for building packages on behalf of
|
||||
@@ -572,7 +556,8 @@ interest primarily for developers and not for casual users.
|
||||
|
||||
@item
|
||||
@c Note: We need at least 0.10.2 for 'channel-send-eof'.
|
||||
Support for build offloading (@pxref{Daemon Offload Setup}) depends on
|
||||
Support for build offloading (@pxref{Daemon Offload Setup}) and
|
||||
@command{guix copy} (@pxref{Invoking guix copy}) depends on
|
||||
@uref{https://github.com/artyom-poptsov/guile-ssh, Guile-SSH},
|
||||
version 0.10.2 or later.
|
||||
|
||||
@@ -1414,10 +1399,14 @@ procedures or dependencies. Guix also goes beyond this obvious set of
|
||||
features.
|
||||
|
||||
This chapter describes the main features of Guix, as well as the package
|
||||
management tools it provides. Two user interfaces are provided for
|
||||
routine package management tasks: A command-line interface described below
|
||||
(@pxref{Invoking guix package, @code{guix package}}), as well as a visual user
|
||||
interface in Emacs described in a subsequent chapter (@pxref{Emacs Interface}).
|
||||
management tools it provides. Along with the command-line interface
|
||||
described below (@pxref{Invoking guix package, @code{guix package}}),
|
||||
you may also use Emacs Interface, after installing @code{emacs-guix}
|
||||
package (run @kbd{M-x guix-help} command to start with it):
|
||||
|
||||
@example
|
||||
guix package -i emacs-guix
|
||||
@end example
|
||||
|
||||
@menu
|
||||
* Features:: How Guix will make your life brighter.
|
||||
@@ -1434,9 +1423,7 @@ interface in Emacs described in a subsequent chapter (@pxref{Emacs Interface}).
|
||||
|
||||
When using Guix, each package ends up in the @dfn{package store}, in its
|
||||
own directory---something that resembles
|
||||
@file{/gnu/store/xxx-package-1.2}, where @code{xxx} is a base32 string
|
||||
(note that Guix comes with an Emacs extension to shorten those file
|
||||
names, @pxref{Emacs Prettify}.)
|
||||
@file{/gnu/store/xxx-package-1.2}, where @code{xxx} is a base32 string.
|
||||
|
||||
Instead of referring to these directories, users have their own
|
||||
@dfn{profile}, which points to the packages that they actually want to
|
||||
@@ -1982,9 +1969,7 @@ also result from derivation builds, can be available as substitutes.
|
||||
|
||||
The @code{hydra.gnu.org} server is a front-end to a build farm that
|
||||
builds packages from the GNU distribution continuously for some
|
||||
architectures, and makes them available as substitutes (@pxref{Emacs
|
||||
Hydra}, for information on how to query the continuous integration
|
||||
server). This is the
|
||||
architectures, and makes them available as substitutes. This is the
|
||||
default source of substitutes; it can be overridden by passing the
|
||||
@option{--substitute-urls} option either to @command{guix-daemon}
|
||||
(@pxref{daemon-substitute-urls,, @code{guix-daemon --substitute-urls}})
|
||||
@@ -2405,11 +2390,13 @@ However, note that, in both examples, all of @code{emacs} and the
|
||||
profile as well as all of their dependencies are transferred (due to
|
||||
@code{-r}), regardless of what is already available in the store on the
|
||||
target machine. The @code{--missing} option can help figure out which
|
||||
items are missing from the target store.
|
||||
items are missing from the target store. The @command{guix copy}
|
||||
command simplifies and optimizes this whole process, so this is probably
|
||||
what you should use in this case (@pxref{Invoking guix copy}).
|
||||
|
||||
@cindex nar, archive format
|
||||
@cindex normalized archive (nar)
|
||||
Archives are stored in the ``normalized archive'' or ``nar'' format, which is
|
||||
By default archives are stored in the ``normalized archive'' or ``nar'' format, which is
|
||||
comparable in spirit to `tar', but with differences
|
||||
that make it more appropriate for our purposes. First, rather than
|
||||
recording all Unix metadata for each file, the nar format only mentions
|
||||
@@ -2425,6 +2412,9 @@ verifies the signature and rejects the import in case of an invalid
|
||||
signature or if the signing key is not authorized.
|
||||
@c FIXME: Add xref to daemon doc about signatures.
|
||||
|
||||
Optionally, archives can be exported as a Docker image in the tar
|
||||
archive format using @code{--format=docker}.
|
||||
|
||||
The main options are:
|
||||
|
||||
@table @code
|
||||
@@ -2453,6 +2443,19 @@ Read a list of store file names from the standard input, one per line,
|
||||
and write on the standard output the subset of these files missing from
|
||||
the store.
|
||||
|
||||
@item -f
|
||||
@item --format=@var{FMT}
|
||||
@cindex docker, export
|
||||
@cindex export format
|
||||
Specify the export format. Acceptable arguments are @code{nar} and
|
||||
@code{docker}. The default is the nar format. When the format is
|
||||
@code{docker}, recursively export the specified store directory as a
|
||||
Docker image in tar archive format, as specified in
|
||||
@uref{https://github.com/docker/docker/blob/master/image/spec/v1.2.md,
|
||||
version 1.2.0 of the Docker Image Specification}. Using
|
||||
@code{--format=docker} implies @code{--recursive}. The generated
|
||||
archive can be loaded by Docker using @command{docker load}.
|
||||
|
||||
@item --generate-key[=@var{parameters}]
|
||||
@cindex signing, archives
|
||||
Generate a new key pair for the daemon. This is a prerequisite before
|
||||
@@ -2509,9 +2512,6 @@ archive contents coming from possibly untrusted substitute servers.
|
||||
|
||||
@end table
|
||||
|
||||
@c *********************************************************************
|
||||
@include emacs.texi
|
||||
|
||||
@c *********************************************************************
|
||||
@node Programming Interface
|
||||
@chapter Programming Interface
|
||||
@@ -4439,6 +4439,7 @@ the Scheme programming interface of Guix in a convenient way.
|
||||
* Invoking guix environment:: Setting up development environments.
|
||||
* Invoking guix publish:: Sharing substitutes.
|
||||
* Invoking guix challenge:: Challenging substitute servers.
|
||||
* Invoking guix copy:: Copying to and from a remote store.
|
||||
* Invoking guix container:: Process isolation.
|
||||
@end menu
|
||||
|
||||
@@ -4491,7 +4492,7 @@ described in the subsections below.
|
||||
|
||||
@menu
|
||||
* Common Build Options:: Build options for most commands.
|
||||
* Package Transformation Options:: Creating variants of packages.
|
||||
* Package Transformation Options:: Creating variants of packages.
|
||||
* Additional Build Options:: Options specific to 'guix build'.
|
||||
@end menu
|
||||
|
||||
@@ -4702,7 +4703,7 @@ procedure (@pxref{Defining Packages, @code{package-input-rewriting}}).
|
||||
|
||||
@item --with-graft=@var{package}=@var{replacement}
|
||||
This is similar to @code{--with-input} but with an important difference:
|
||||
instead of rebuilding all the dependency chain, @var{replacement} is
|
||||
instead of rebuilding the whole dependency chain, @var{replacement} is
|
||||
built and then @dfn{grafted} onto the binaries that were initially
|
||||
referring to @var{package}. @xref{Security Updates}, for more
|
||||
information on grafts.
|
||||
@@ -4923,11 +4924,6 @@ have created your own packages on @code{GUIX_PACKAGE_PATH}
|
||||
recipes. Otherwise, you will be able to examine the read-only recipes
|
||||
for packages currently in the store.
|
||||
|
||||
If you are using Emacs, note that the Emacs user interface provides the
|
||||
@kbd{M-x guix-edit} command and a similar functionality in the ``package
|
||||
info'' and ``package list'' buffers created by the @kbd{M-x
|
||||
guix-search-by-name} and similar commands (@pxref{Emacs Commands}).
|
||||
|
||||
|
||||
@node Invoking guix download
|
||||
@section Invoking @command{guix download}
|
||||
@@ -5467,6 +5463,10 @@ end, display the fraction of packages covered by all these updaters.
|
||||
List top-level dependent packages that would need to be rebuilt as a
|
||||
result of upgrading one or more packages.
|
||||
|
||||
@xref{Invoking guix graph, the @code{reverse-package} type of
|
||||
@command{guix graph}}, for information on how to visualize the list of
|
||||
dependents of a package.
|
||||
|
||||
@end table
|
||||
|
||||
Be aware that the @code{--list-dependent} option only
|
||||
@@ -5768,6 +5768,20 @@ This is the default type used in the example above. It shows the DAG of
|
||||
package objects, excluding implicit dependencies. It is concise, but
|
||||
filters out many details.
|
||||
|
||||
@item reverse-package
|
||||
This shows the @emph{reverse} DAG of packages. For example:
|
||||
|
||||
@example
|
||||
guix graph --type=reverse-package ocaml
|
||||
@end example
|
||||
|
||||
... yields the graph of packages that depend on OCaml.
|
||||
|
||||
Note that for core packages this can yield huge graphs. If all you want
|
||||
is to know the number of packages that depend on a given package, use
|
||||
@command{guix refresh --list-dependent} (@pxref{Invoking guix refresh,
|
||||
@option{--list-dependent}}).
|
||||
|
||||
@item bag-emerged
|
||||
This is the package DAG, @emph{including} implicit inputs.
|
||||
|
||||
@@ -5997,6 +6011,21 @@ The @code{--container} option requires Linux-libre 3.19 or newer.
|
||||
The available options are summarized below.
|
||||
|
||||
@table @code
|
||||
@item --root=@var{file}
|
||||
@itemx -r @var{file}
|
||||
@cindex persistent environment
|
||||
@cindex garbage collector root, for environments
|
||||
Make @var{file} a symlink to the profile for this environment, and
|
||||
register it as a garbage collector root.
|
||||
|
||||
This is useful if you want to protect your environment from garbage
|
||||
collection, to make it ``persistent''.
|
||||
|
||||
When this option is omitted, the environment is protected from garbage
|
||||
collection only for the duration of the @command{guix environment}
|
||||
session. This means that next time you recreate the same environment,
|
||||
you could have to rebuild or re-download packages.
|
||||
|
||||
@item --expression=@var{expr}
|
||||
@itemx -e @var{expr}
|
||||
Create an environment for the package or list of packages that
|
||||
@@ -6385,6 +6414,68 @@ URLs to compare to.
|
||||
|
||||
@end table
|
||||
|
||||
@node Invoking guix copy
|
||||
@section Invoking @command{guix copy}
|
||||
|
||||
@cindex copy, of store items, over SSH
|
||||
@cindex SSH, copy of store items
|
||||
@cindex sharing store items across machines
|
||||
@cindex transferring store items across machines
|
||||
The @command{guix copy} command copies items from the store of one
|
||||
machine to that of another machine over a secure shell (SSH)
|
||||
connection@footnote{This command is available only when Guile-SSH was
|
||||
found. @xref{Requirements}, for details.}. For example, the following
|
||||
command copies the @code{coreutils} package, the user's profile, and all
|
||||
their dependencies over to @var{host}, logged in as @var{user}:
|
||||
|
||||
@example
|
||||
guix copy --to=@var{user}@@@var{host} \
|
||||
coreutils `readlink -f ~/.guix-profile`
|
||||
@end example
|
||||
|
||||
If some of the items to be copied are already present on @var{host},
|
||||
they are not actually sent.
|
||||
|
||||
The command below retrieves @code{libreoffice} and @code{gimp} from
|
||||
@var{host}, assuming they are available there:
|
||||
|
||||
@example
|
||||
guix copy --from=@var{host} libreoffice gimp
|
||||
@end example
|
||||
|
||||
The SSH connection is established using the Guile-SSH client, which is
|
||||
compatible with OpenSSH: it honors @file{~/.ssh/known_hosts} and
|
||||
@file{~/.ssh/config}, and uses the SSH agent for authentication.
|
||||
|
||||
The key used to sign items that are sent must be accepted by the remote
|
||||
machine. Likewise, the key used by the remote machine to sign items you
|
||||
are retrieving must be in @file{/etc/guix/acl} so it is accepted by your
|
||||
own daemon. @xref{Invoking guix archive}, for more information about
|
||||
store item authentication.
|
||||
|
||||
The general syntax is:
|
||||
|
||||
@example
|
||||
guix copy [--to=@var{spec}|--from=@var{spec}] @var{items}@dots{}
|
||||
@end example
|
||||
|
||||
You must always specify one of the following options:
|
||||
|
||||
@table @code
|
||||
@item --to=@var{spec}
|
||||
@itemx --from=@var{spec}
|
||||
Specify the host to send to or receive from. @var{spec} must be an SSH
|
||||
spec such as @code{example.org}, @code{charlie@@example.org}, or
|
||||
@code{charlie@@example.org:2222}.
|
||||
@end table
|
||||
|
||||
The @var{items} can be either package names, such as @code{gimp}, or
|
||||
store items, such as @file{/gnu/store/@dots{}-idutils-4.6}.
|
||||
|
||||
When specifying the name of a package to send, it is first built if
|
||||
needed, unless @option{--dry-run} was specified. Common build options
|
||||
are supported (@pxref{Common Build Options}).
|
||||
|
||||
|
||||
@node Invoking guix container
|
||||
@section Invoking @command{guix container}
|
||||
@@ -6828,9 +6919,9 @@ cfdisk
|
||||
|
||||
Once you are done partitioning the target hard disk drive, you have to
|
||||
create a file system on the relevant partition(s)@footnote{Currently
|
||||
GuixSD pretty much assumes an ext4 file system. In particular, code
|
||||
that reads partition UUIDs and labels only works with ext4. This will
|
||||
be fixed in the future.}.
|
||||
GuixSD only supports ext4 and btrfs file systems. In particular, code
|
||||
that reads partition UUIDs and labels only works for these file system
|
||||
types.}.
|
||||
|
||||
Preferably, assign partitions a label so that you can easily and
|
||||
reliably refer to them in @code{file-system} declarations (@pxref{File
|
||||
@@ -8021,6 +8112,7 @@ declaration.
|
||||
* Desktop Services:: D-Bus and desktop services.
|
||||
* Database Services:: SQL databases.
|
||||
* Mail Services:: IMAP, POP3, SMTP, and all that.
|
||||
* Messaging Services:: Messaging services.
|
||||
* Kerberos Services:: Kerberos services.
|
||||
* Web Services:: Web servers.
|
||||
* Network File System:: NFS related services.
|
||||
@@ -11635,6 +11727,394 @@ remote servers. Run @command{man smtpd.conf} for more information.
|
||||
@end table
|
||||
@end deftp
|
||||
|
||||
@node Messaging Services
|
||||
@subsubsection Messaging Services
|
||||
|
||||
@cindex messaging
|
||||
@cindex jabber
|
||||
@cindex XMPP
|
||||
The @code{(gnu services messaging)} module provides Guix service
|
||||
definitions for messaging services: currently only Prosody is supported.
|
||||
|
||||
@subsubheading Prosody Service
|
||||
|
||||
@deffn {Scheme Variable} prosody-service-type
|
||||
This is the type for the @uref{http://prosody.im, Prosody XMPP
|
||||
communication server}. Its value must be a @code{prosody-configuration}
|
||||
record as in this example:
|
||||
|
||||
@example
|
||||
(service prosody-service-type
|
||||
(prosody-configuration
|
||||
(modules-enabled (cons "groups" %default-modules-enabled))
|
||||
(int-components
|
||||
(list
|
||||
(int-component-configuration
|
||||
(hostname "conference.example.net")
|
||||
(plugin "muc")
|
||||
(mod-muc (mod-muc-configuration)))))
|
||||
(virtualhosts
|
||||
(list
|
||||
(virtualhost-configuration
|
||||
(domain "example.net"))))))
|
||||
@end example
|
||||
|
||||
See below for details about @code{prosody-configuration}.
|
||||
|
||||
@end deffn
|
||||
|
||||
By default, Prosody does not need much configuration. Only one
|
||||
@code{virtualhosts} field is needed: it specifies the domain you wish
|
||||
Prosody to serve.
|
||||
|
||||
Prosodyctl will help you generate X.509 certificates and keys:
|
||||
|
||||
@example
|
||||
prosodyctl cert request example.net
|
||||
@end example
|
||||
|
||||
The available configuration parameters follow. Each parameter
|
||||
definition is preceded by its type; for example, @samp{string-list foo}
|
||||
indicates that the @code{foo} parameter should be specified as a list of
|
||||
strings. Types starting with @code{maybe-} denote parameters that won't
|
||||
show up in @code{prosody.cfg.lua} when their value is @code{'disabled}.
|
||||
|
||||
There is also a way to specify the configuration as a string, if you
|
||||
have an old @code{prosody.cfg.lua} file that you want to port over from
|
||||
some other system; see the end for more details.
|
||||
|
||||
@c The following documentation was initially generated by
|
||||
@c (generate-documentation) in (gnu services messaging). Manually maintained
|
||||
@c documentation is better, so we shouldn't hesitate to edit below as
|
||||
@c needed. However if the change you want to make to this documentation
|
||||
@c can be done in an automated way, it's probably easier to change
|
||||
@c (generate-documentation) than to make it below and have to deal with
|
||||
@c the churn as Prosody updates.
|
||||
|
||||
Available @code{prosody-configuration} fields are:
|
||||
|
||||
@deftypevr {@code{prosody-configuration} parameter} package prosody
|
||||
The Prosody package.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{prosody-configuration} parameter} file-name data-path
|
||||
Location of the Prosody data storage directory. See
|
||||
@url{http://prosody.im/doc/configure}.
|
||||
Defaults to @samp{"/var/lib/prosody"}.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{prosody-configuration} parameter} file-name-list plugin-paths
|
||||
Additional plugin directories. They are searched in all the specified
|
||||
paths in order. See @url{http://prosody.im/doc/plugins_directory}.
|
||||
Defaults to @samp{()}.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{prosody-configuration} parameter} string-list admins
|
||||
This is a list of accounts that are admins for the server. Note that you
|
||||
must create the accounts separately. See @url{http://prosody.im/doc/admins} and
|
||||
@url{http://prosody.im/doc/creating_accounts}.
|
||||
Example: @code{(admins '("user1@@example.com" "user2@@example.net"))}
|
||||
Defaults to @samp{()}.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{prosody-configuration} parameter} boolean use-libevent?
|
||||
Enable use of libevent for better performance under high load. See
|
||||
@url{http://prosody.im/doc/libevent}.
|
||||
Defaults to @samp{#f}.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{prosody-configuration} parameter} module-list modules-enabled
|
||||
This is the list of modules Prosody will load on startup. It looks for
|
||||
@code{mod_modulename.lua} in the plugins folder, so make sure that exists too.
|
||||
Documentation on modules can be found at: @url{http://prosody.im/doc/modules}.
|
||||
Defaults to @samp{%default-modules-enabled}.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{prosody-configuration} parameter} string-list modules-disabled
|
||||
@samp{"offline"}, @samp{"c2s"} and @samp{"s2s"} are auto-loaded, but
|
||||
should you want to disable them then add them to this list.
|
||||
Defaults to @samp{()}.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{prosody-configuration} parameter} file-name groups-file
|
||||
Path to a text file where the shared groups are defined. If this path is
|
||||
empty then @samp{mod_groups} does nothing. See
|
||||
@url{http://prosody.im/doc/modules/mod_groups}.
|
||||
Defaults to @samp{"/var/lib/prosody/sharedgroups.txt"}.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{prosody-configuration} parameter} boolean allow-registration?
|
||||
Disable account creation by default, for security. See
|
||||
@url{http://prosody.im/doc/creating_accounts}.
|
||||
Defaults to @samp{#f}.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{prosody-configuration} parameter} maybe-ssl-configuration ssl
|
||||
These are the SSL/TLS-related settings. Most of them are disabled so to
|
||||
use Prosody's defaults. If you do not completely understand these options, do
|
||||
not add them to your config, it is easy to lower the security of your server
|
||||
using them. See @url{http://prosody.im/doc/advanced_ssl_config}.
|
||||
|
||||
Available @code{ssl-configuration} fields are:
|
||||
|
||||
@deftypevr {@code{ssl-configuration} parameter} maybe-string protocol
|
||||
This determines what handshake to use.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{ssl-configuration} parameter} file-name key
|
||||
Path to your private key file, relative to @code{/etc/prosody}.
|
||||
Defaults to @samp{"/etc/prosody/certs/key.pem"}.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{ssl-configuration} parameter} file-name certificate
|
||||
Path to your certificate file, relative to @code{/etc/prosody}.
|
||||
Defaults to @samp{"/etc/prosody/certs/cert.pem"}.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{ssl-configuration} parameter} file-name capath
|
||||
Path to directory containing root certificates that you wish Prosody to
|
||||
trust when verifying the certificates of remote servers.
|
||||
Defaults to @samp{"/etc/ssl/certs"}.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{ssl-configuration} parameter} maybe-file-name cafile
|
||||
Path to a file containing root certificates that you wish Prosody to trust.
|
||||
Similar to @code{capath} but with all certificates concatenated together.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{ssl-configuration} parameter} maybe-string-list verify
|
||||
A list of verification options (these mostly map to OpenSSL's
|
||||
@code{set_verify()} flags).
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{ssl-configuration} parameter} maybe-string-list options
|
||||
A list of general options relating to SSL/TLS. These map to OpenSSL's
|
||||
@code{set_options()}. For a full list of options available in LuaSec, see the
|
||||
LuaSec source.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{ssl-configuration} parameter} maybe-non-negative-integer depth
|
||||
How long a chain of certificate authorities to check when looking for a
|
||||
trusted root certificate.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{ssl-configuration} parameter} maybe-string ciphers
|
||||
An OpenSSL cipher string. This selects what ciphers Prosody will offer to
|
||||
clients, and in what order.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{ssl-configuration} parameter} maybe-file-name dhparam
|
||||
A path to a file containing parameters for Diffie-Hellman key exchange. You
|
||||
can create such a file with:
|
||||
@code{openssl dhparam -out /etc/prosody/certs/dh-2048.pem 2048}
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{ssl-configuration} parameter} maybe-string curve
|
||||
Curve for Elliptic curve Diffie-Hellman. Prosody's default is
|
||||
@samp{"secp384r1"}.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{ssl-configuration} parameter} maybe-string-list verifyext
|
||||
A list of "extra" verification options.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{ssl-configuration} parameter} maybe-string password
|
||||
Password for encrypted private keys.
|
||||
@end deftypevr
|
||||
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{prosody-configuration} parameter} boolean c2s-require-encryption?
|
||||
Whether to force all client-to-server connections to be encrypted or not.
|
||||
See @url{http://prosody.im/doc/modules/mod_tls}.
|
||||
Defaults to @samp{#f}.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{prosody-configuration} parameter} boolean s2s-require-encryption?
|
||||
Whether to force all server-to-server connections to be encrypted or not.
|
||||
See @url{http://prosody.im/doc/modules/mod_tls}.
|
||||
Defaults to @samp{#f}.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{prosody-configuration} parameter} boolean s2s-secure-auth?
|
||||
Whether to require encryption and certificate authentication. This
|
||||
provides ideal security, but requires servers you communicate with to support
|
||||
encryption AND present valid, trusted certificates. See
|
||||
@url{http://prosody.im/doc/s2s#security}.
|
||||
Defaults to @samp{#f}.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{prosody-configuration} parameter} string-list s2s-insecure-domains
|
||||
Many servers don't support encryption or have invalid or self-signed
|
||||
certificates. You can list domains here that will not be required to
|
||||
authenticate using certificates. They will be authenticated using DNS. See
|
||||
@url{http://prosody.im/doc/s2s#security}.
|
||||
Defaults to @samp{()}.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{prosody-configuration} parameter} string-list s2s-secure-domains
|
||||
Even if you leave @code{s2s-secure-auth?} disabled, you can still require
|
||||
valid certificates for some domains by specifying a list here. See
|
||||
@url{http://prosody.im/doc/s2s#security}.
|
||||
Defaults to @samp{()}.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{prosody-configuration} parameter} string authentication
|
||||
Select the authentication backend to use. The default provider stores
|
||||
passwords in plaintext and uses Prosody's configured data storage to store the
|
||||
authentication data. If you do not trust your server please see
|
||||
@url{http://prosody.im/doc/modules/mod_auth_internal_hashed} for information
|
||||
about using the hashed backend. See also
|
||||
@url{http://prosody.im/doc/authentication}
|
||||
Defaults to @samp{"internal_plain"}.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{prosody-configuration} parameter} maybe-string log
|
||||
Set logging options. Advanced logging configuration is not yet supported
|
||||
by the GuixSD Prosody Service. See @url{http://prosody.im/doc/logging}.
|
||||
Defaults to @samp{"*syslog"}.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{prosody-configuration} parameter} file-name pidfile
|
||||
File to write pid in. See @url{http://prosody.im/doc/modules/mod_posix}.
|
||||
Defaults to @samp{"/var/run/prosody/prosody.pid"}.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{prosody-configuration} parameter} virtualhost-configuration-list virtualhosts
|
||||
A host in Prosody is a domain on which user accounts can be created. For
|
||||
example if you want your users to have addresses like
|
||||
@samp{"john.smith@@example.com"} then you need to add a host
|
||||
@samp{"example.com"}. All options in this list will apply only to this host.
|
||||
|
||||
Note: the name "virtual" host is used in configuration to avoid confusion with
|
||||
the actual physical host that Prosody is installed on. A single Prosody
|
||||
instance can serve many domains, each one defined as a VirtualHost entry in
|
||||
Prosody's configuration. Conversely a server that hosts a single domain would
|
||||
have just one VirtualHost entry.
|
||||
|
||||
See @url{http://prosody.im/doc/configure#virtual_host_settings}.
|
||||
|
||||
Available @code{virtualhost-configuration} fields are:
|
||||
|
||||
all these @code{prosody-configuration} fields: @code{admins}, @code{use-libevent?}, @code{modules-enabled}, @code{modules-disabled}, @code{groups-file}, @code{allow-registration?}, @code{ssl}, @code{c2s-require-encryption?}, @code{s2s-require-encryption?}, @code{s2s-secure-auth?}, @code{s2s-insecure-domains}, @code{s2s-secure-domains}, @code{authentication}, @code{log}, plus:
|
||||
@deftypevr {@code{virtualhost-configuration} parameter} string domain
|
||||
Domain you wish Prosody to serve.
|
||||
@end deftypevr
|
||||
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{prosody-configuration} parameter} int-component-configuration-list int-components
|
||||
Components are extra services on a server which are available to clients,
|
||||
usually on a subdomain of the main server (such as
|
||||
@samp{"mycomponent.example.com"}). Example components might be chatroom
|
||||
servers, user directories, or gateways to other protocols.
|
||||
|
||||
Internal components are implemented with Prosody-specific plugins. To add an
|
||||
internal component, you simply fill the hostname field, and the plugin you wish
|
||||
to use for the component.
|
||||
|
||||
See @url{http://prosody.im/doc/components}.
|
||||
Defaults to @samp{()}.
|
||||
|
||||
Available @code{int-component-configuration} fields are:
|
||||
|
||||
all these @code{prosody-configuration} fields: @code{admins}, @code{use-libevent?}, @code{modules-enabled}, @code{modules-disabled}, @code{groups-file}, @code{allow-registration?}, @code{ssl}, @code{c2s-require-encryption?}, @code{s2s-require-encryption?}, @code{s2s-secure-auth?}, @code{s2s-insecure-domains}, @code{s2s-secure-domains}, @code{authentication}, @code{log}, plus:
|
||||
@deftypevr {@code{int-component-configuration} parameter} string hostname
|
||||
Hostname of the component.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{int-component-configuration} parameter} string plugin
|
||||
Plugin you wish to use for the component.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{int-component-configuration} parameter} maybe-mod-muc-configuration mod-muc
|
||||
Multi-user chat (MUC) is Prosody's module for allowing you to create
|
||||
hosted chatrooms/conferences for XMPP users.
|
||||
|
||||
General information on setting up and using multi-user chatrooms can be found
|
||||
in the "Chatrooms" documentation (@url{http://prosody.im/doc/chatrooms}),
|
||||
which you should read if you are new to XMPP chatrooms.
|
||||
|
||||
See also @url{http://prosody.im/doc/modules/mod_muc}.
|
||||
|
||||
Available @code{mod-muc-configuration} fields are:
|
||||
|
||||
@deftypevr {@code{mod-muc-configuration} parameter} string name
|
||||
The name to return in service discovery responses.
|
||||
Defaults to @samp{"Prosody Chatrooms"}.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{mod-muc-configuration} parameter} string-or-boolean restrict-room-creation
|
||||
If @samp{#t}, this will only allow admins to create new chatrooms.
|
||||
Otherwise anyone can create a room. The value @samp{"local"} restricts room
|
||||
creation to users on the service's parent domain. E.g. @samp{user@@example.com}
|
||||
can create rooms on @samp{rooms.example.com}. The value @samp{"admin"}
|
||||
restricts to service administrators only.
|
||||
Defaults to @samp{#f}.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{mod-muc-configuration} parameter} non-negative-integer max-history-messages
|
||||
Maximum number of history messages that will be sent to the member that has
|
||||
just joined the room.
|
||||
Defaults to @samp{20}.
|
||||
@end deftypevr
|
||||
|
||||
@end deftypevr
|
||||
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{prosody-configuration} parameter} ext-component-configuration-list ext-components
|
||||
External components use XEP-0114, which most standalone components
|
||||
support. To add an external component, you simply fill the hostname field. See
|
||||
@url{http://prosody.im/doc/components}.
|
||||
Defaults to @samp{()}.
|
||||
|
||||
Available @code{ext-component-configuration} fields are:
|
||||
|
||||
all these @code{prosody-configuration} fields: @code{admins}, @code{use-libevent?}, @code{modules-enabled}, @code{modules-disabled}, @code{groups-file}, @code{allow-registration?}, @code{ssl}, @code{c2s-require-encryption?}, @code{s2s-require-encryption?}, @code{s2s-secure-auth?}, @code{s2s-insecure-domains}, @code{s2s-secure-domains}, @code{authentication}, @code{log}, plus:
|
||||
@deftypevr {@code{ext-component-configuration} parameter} string component-secret
|
||||
Password which the component will use to log in.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{ext-component-configuration} parameter} string hostname
|
||||
Hostname of the component.
|
||||
@end deftypevr
|
||||
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{prosody-configuration} parameter} non-negative-integer-list component-ports
|
||||
Port(s) Prosody listens on for component connections.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{prosody-configuration} parameter} string component-interface
|
||||
Interface Prosody listens on for component connections.
|
||||
Defaults to @samp{"127.0.0.1"}.
|
||||
@end deftypevr
|
||||
|
||||
It could be that you just want to get a @code{prosody.cfg.lua}
|
||||
up and running. In that case, you can pass an
|
||||
@code{opaque-prosody-configuration} record as the value of
|
||||
@code{prosody-service-type}. As its name indicates, an opaque configuration
|
||||
does not have easy reflective capabilities.
|
||||
Available @code{opaque-prosody-configuration} fields are:
|
||||
|
||||
@deftypevr {@code{opaque-prosody-configuration} parameter} package prosody
|
||||
The prosody package.
|
||||
@end deftypevr
|
||||
|
||||
@deftypevr {@code{opaque-prosody-configuration} parameter} string prosody.cfg.lua
|
||||
The contents of the @code{prosody.cfg.lua} to use.
|
||||
@end deftypevr
|
||||
|
||||
For example, if your @code{prosody.cfg.lua} is just the empty
|
||||
string, you could instantiate a prosody service like this:
|
||||
|
||||
@example
|
||||
(service prosody-service-type
|
||||
(opaque-prosody-configuration
|
||||
(prosody.cfg.lua "")))
|
||||
@end example
|
||||
|
||||
@node Kerberos Services
|
||||
@subsubsection Kerberos Services
|
||||
@cindex Kerberos
|
||||
@@ -11772,8 +12252,8 @@ The @code{(gnu services web)} module provides the following service:
|
||||
@deffn {Scheme Procedure} nginx-service [#:nginx nginx] @
|
||||
[#:log-directory ``/var/log/nginx''] @
|
||||
[#:run-directory ``/var/run/nginx''] @
|
||||
[#:vhost-list (list (nginx-vhost-configuration))] @
|
||||
[#:config-file]
|
||||
[#:server-list '()] @
|
||||
[#:config-file @code{#f}]
|
||||
|
||||
Return a service that runs @var{nginx}, the nginx web server.
|
||||
|
||||
@@ -11783,32 +12263,46 @@ files are written to @var{run-directory}. For proper operation, these
|
||||
arguments should match what is in @var{config-file} to ensure that the
|
||||
directories are created when the service is activated.
|
||||
|
||||
As an alternative to using a @var{config-file}, @var{vhost-list} can be
|
||||
used to specify the list of @dfn{virtual hosts} required on the host. For
|
||||
As an alternative to using a @var{config-file}, @var{server-list} can be
|
||||
used to specify the list of @dfn{server blocks} required on the host. For
|
||||
this to work, use the default value for @var{config-file}.
|
||||
|
||||
@end deffn
|
||||
|
||||
@deftp {Data Type} nginx-vhost-configuration
|
||||
Data type representing the configuration of an nginx virtual host.
|
||||
@deffn {Scheme Variable} nginx-service-type
|
||||
This is type for the nginx web server.
|
||||
|
||||
This service can be extended to add server blocks in addition to the
|
||||
default one, as in this example:
|
||||
|
||||
@example
|
||||
(simple-service 'my-extra-server nginx-service-type
|
||||
(list (nginx-server-configuration
|
||||
(https-port #f)
|
||||
(root "/srv/http/extra-website"))))
|
||||
@end example
|
||||
@end deffn
|
||||
|
||||
@deftp {Data Type} nginx-server-configuration
|
||||
Data type representing the configuration of an nginx server block.
|
||||
This type has the following parameters:
|
||||
|
||||
@table @asis
|
||||
@item @code{http-port} (default: @code{80})
|
||||
Nginx will listen for HTTP connection on this port. Set it at @code{#f} if
|
||||
nginx should not listen for HTTP (non secure) connection for this
|
||||
@dfn{virtual host}.
|
||||
@dfn{server block}.
|
||||
|
||||
@item @code{https-port} (default: @code{443})
|
||||
Nginx will listen for HTTPS connection on this port. Set it at @code{#f} if
|
||||
nginx should not listen for HTTPS (secure) connection for this @dfn{virtual host}.
|
||||
nginx should not listen for HTTPS (secure) connection for this @dfn{server block}.
|
||||
|
||||
Note that nginx can listen for HTTP and HTTPS connections in the same
|
||||
@dfn{virtual host}.
|
||||
@dfn{server block}.
|
||||
|
||||
@item @code{server-name} (default: @code{(list 'default)})
|
||||
A list of server names this vhost represents. @code{'default} represents the
|
||||
default vhost for connections matching no other vhost.
|
||||
A list of server names this server represents. @code{'default} represents the
|
||||
default server for connections matching no other server.
|
||||
|
||||
@item @code{root} (default: @code{"/srv/http"})
|
||||
Root of the website nginx will serve.
|
||||
@@ -11956,36 +12450,38 @@ providing substitutes to others (@pxref{Substitutes}).
|
||||
|
||||
The @code{(gnu services cuirass)} module provides the following service.
|
||||
|
||||
@deffn {Scheme Procedure} cuirass-service @
|
||||
[#:config @code{(cuirass-configuration)}]
|
||||
Return a service that runs @command{cuirass}.
|
||||
@defvr {Scheme Procedure} cuirass-service-type
|
||||
The type of the Cuirass service. Its value must be a
|
||||
@code{cuirass-configuration} object, as described below.
|
||||
@end defvr
|
||||
|
||||
The @var{#:config} keyword argument specifies the configuration for
|
||||
@command{cuirass}, which must be a @code{<cuirass-configuration>}
|
||||
object, by default it doesn't provide any build job. If you want to
|
||||
provide your own configuration you will most likely use the
|
||||
@code{cuirass-configuration} special form which returns such objects.
|
||||
@end deffn
|
||||
|
||||
In order to add build jobs you will have to set the
|
||||
@code{specifications} field. Here is an example of a cuirass service
|
||||
defining a build job based on a specification that can be found in
|
||||
Cuirass source tree.
|
||||
To add build jobs, you have to set the @code{specifications} field of
|
||||
the configuration. Here is an example of a service defining a build job
|
||||
based on a specification that can be found in Cuirass source tree. This
|
||||
service polls the Guix repository and builds a subset of the Guix
|
||||
packages, as prescribed in the @file{gnu-system.scm} example spec:
|
||||
|
||||
@example
|
||||
(let ((spec `((#:name . "guix")
|
||||
(#:url . "git://git.savannah.gnu.org/guix.git")
|
||||
(#:load-path . ".")
|
||||
;; Adapt to a valid absolute file name.
|
||||
(#:file . "/.../cuirass/tests/gnu-system.scm")
|
||||
(#:proc . hydra-jobs)
|
||||
(#:arguments (subset . "hello"))
|
||||
(#:branch . "master"))))
|
||||
(cuirass-service #:config (cuirass-configuration
|
||||
(specifications (list spec)))))
|
||||
(let ((spec #~((#:name . "guix")
|
||||
(#:url . "git://git.savannah.gnu.org/guix.git")
|
||||
(#:load-path . ".")
|
||||
|
||||
;; Here we must provide an absolute file name.
|
||||
;; We take jobs from one of the examples provided
|
||||
;; by Cuirass.
|
||||
(#:file . #$(file-append
|
||||
cuirass
|
||||
"/tests/gnu-system.scm"))
|
||||
|
||||
(#:proc . hydra-jobs)
|
||||
(#:arguments (subset . "hello"))
|
||||
(#:branch . "master"))))
|
||||
(service cuirass-service-type
|
||||
(cuirass-configuration
|
||||
(specifications #~(list #$spec)))))
|
||||
@end example
|
||||
|
||||
While information related to build jobs are located directly in the
|
||||
While information related to build jobs is located directly in the
|
||||
specifications, global settings for the @command{cuirass} process are
|
||||
accessible in other @code{cuirass-configuration} fields.
|
||||
|
||||
@@ -12013,8 +12509,9 @@ Cuirass jobs.
|
||||
Location of sqlite database which contains the build results and previously
|
||||
added specifications.
|
||||
|
||||
@item @code{specifications} (default: @code{'()})
|
||||
A list of specifications, where a specification is an association list
|
||||
@item @code{specifications} (default: @code{#~'()})
|
||||
A gexp (@pxref{G-Expressions}) that evaluates to a list of specifications,
|
||||
where a specification is an association list
|
||||
(@pxref{Associations Lists,,, guile, GNU Guile Reference Manual}) whose
|
||||
keys are keywords (@code{#:keyword-example}) as shown in the example
|
||||
above.
|
||||
|
||||
@@ -219,6 +219,8 @@ emacs node ${EMACS}/html_node/emacs/
|
||||
easejs mono ${GS}/easejs/manual/easejs.html
|
||||
easejs node ${GS}/easejs/manual/
|
||||
|
||||
emacs-guix mono https://notabug.org/alezost/emacs-guix
|
||||
|
||||
emacs-muse node ${GS}/emacs-muse/manual/muse.html
|
||||
emacs-muse node ${GS}/emacs-muse/manual/html_node/
|
||||
|
||||
|
||||
@@ -1,37 +0,0 @@
|
||||
;;; guix-about.el --- Various info about Guix
|
||||
|
||||
;; Copyright © 2016 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public Location as published by
|
||||
;; the Free Software Foundation, either version 3 of the Location, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public Location for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public Location
|
||||
;; along with this program. If not, see <http://www.gnu.org/locations/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides the code to display various info about Guix (e.g., its
|
||||
;; version).
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'guix-config)
|
||||
|
||||
;;;###autoload
|
||||
(defun guix-version ()
|
||||
"Display Guix version in the echo area."
|
||||
(interactive)
|
||||
(message "%s %s" guix-config-name guix-config-version))
|
||||
|
||||
(provide 'guix-about)
|
||||
|
||||
;;; guix-about.el ends here
|
||||
@@ -1,393 +0,0 @@
|
||||
;;; guix-backend.el --- Making and using Guix REPL
|
||||
|
||||
;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides the code for interacting with Guile using Guix REPL
|
||||
;; (Geiser REPL with some guix-specific additions).
|
||||
|
||||
;; By default (if `guix-use-guile-server' is non-nil) 2 Guix REPLs are
|
||||
;; started. The main one (with "guile --listen" process) is used for
|
||||
;; "interacting" with a user - for showing a progress of
|
||||
;; installing/deleting Guix packages. The second (internal) REPL is
|
||||
;; used for synchronous evaluating, e.g. when information about
|
||||
;; packages/generations should be received for a list/info buffer.
|
||||
;;
|
||||
;; This "2 REPLs concept" makes it possible to have a running process of
|
||||
;; installing/deleting packages and to continue to search/list/get info
|
||||
;; about other packages at the same time. If you prefer to use a single
|
||||
;; Guix REPL, do not try to receive any information while there is a
|
||||
;; running code in the REPL (see
|
||||
;; <https://github.com/jaor/geiser/issues/28>).
|
||||
;;
|
||||
;; Guix REPLs (unlike the usual Geiser REPLs) are not added to
|
||||
;; `geiser-repl--repls' variable, and thus cannot be used for evaluating
|
||||
;; while editing scm-files. The only purpose of Guix REPLs is to be an
|
||||
;; intermediate between "Guix/Guile level" and "Emacs interface level".
|
||||
;; That being said you can still want to use a Guix REPL while hacking
|
||||
;; auxiliary scheme-files for "guix.el". You can just use
|
||||
;; `geiser-connect-local' command with `guix-repl-current-socket' to
|
||||
;; have a usual Geiser REPL with all stuff defined by "guix.el" package.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'geiser-mode)
|
||||
(require 'geiser-guile)
|
||||
(require 'guix-geiser)
|
||||
(require 'guix-config)
|
||||
(require 'guix-external)
|
||||
(require 'guix-emacs)
|
||||
(require 'guix-profiles)
|
||||
|
||||
(defvar guix-load-path guix-config-emacs-interface-directory
|
||||
"Directory with scheme files for \"guix.el\" package.")
|
||||
|
||||
(defvar guix-helper-file
|
||||
(expand-file-name "guix-helper.scm" guix-load-path)
|
||||
"Auxiliary scheme file for loading.")
|
||||
|
||||
|
||||
;;; REPL
|
||||
|
||||
(defgroup guix-repl nil
|
||||
"Settings for Guix REPLs."
|
||||
:prefix "guix-repl-"
|
||||
:group 'guix)
|
||||
|
||||
(defcustom guix-repl-startup-time 30000
|
||||
"Time, in milliseconds, to wait for Guix REPL to startup.
|
||||
Same as `geiser-repl-startup-time' but is used for Guix REPL.
|
||||
If you have a slow system, try to increase this time."
|
||||
:type 'integer
|
||||
:group 'guix-repl)
|
||||
|
||||
(defcustom guix-repl-buffer-name "*Guix REPL*"
|
||||
"Default name of a Geiser REPL buffer used for Guix."
|
||||
:type 'string
|
||||
:group 'guix-repl)
|
||||
|
||||
(defcustom guix-after-start-repl-hook '(guix-set-directory)
|
||||
"Hook called after Guix REPL is started."
|
||||
:type 'hook
|
||||
:group 'guix-repl)
|
||||
|
||||
(defcustom guix-use-guile-server t
|
||||
"If non-nil, start guile with '--listen' argument.
|
||||
This allows to receive information about packages using an additional
|
||||
REPL while some packages are being installed/removed in the main REPL."
|
||||
:type 'boolean
|
||||
:group 'guix-repl)
|
||||
|
||||
(defcustom guix-repl-socket-file-name-function
|
||||
#'guix-repl-socket-file-name
|
||||
"Function used to define a socket file name used by Guix REPL.
|
||||
The function is called without arguments."
|
||||
:type '(choice (function-item guix-repl-socket-file-name)
|
||||
(function :tag "Other function"))
|
||||
:group 'guix-repl)
|
||||
|
||||
(defcustom guix-emacs-activate-after-operation t
|
||||
"Activate Emacs packages after installing.
|
||||
If nil, do not load autoloads of the Emacs packages after
|
||||
they are successfully installed."
|
||||
:type 'boolean
|
||||
:group 'guix-repl)
|
||||
|
||||
(defvar guix-repl-current-socket nil
|
||||
"Name of a socket file used by the current Guix REPL.")
|
||||
|
||||
(defvar guix-repl-buffer nil
|
||||
"Main Geiser REPL buffer used for communicating with Guix.
|
||||
This REPL is used for processing package actions and for
|
||||
receiving information if `guix-use-guile-server' is nil.")
|
||||
|
||||
(defvar guix-internal-repl-buffer nil
|
||||
"Additional Geiser REPL buffer used for communicating with Guix.
|
||||
This REPL is used for receiving information only if
|
||||
`guix-use-guile-server' is non-nil.")
|
||||
|
||||
(defvar guix-internal-repl-buffer-name "*Guix Internal REPL*"
|
||||
"Default name of an internal Guix REPL buffer.")
|
||||
|
||||
(defvar guix-before-repl-operation-hook nil
|
||||
"Hook run before executing an operation in Guix REPL.")
|
||||
|
||||
(defvar guix-after-repl-operation-hook
|
||||
'(guix-repl-autoload-emacs-packages-maybe
|
||||
guix-repl-operation-success-message)
|
||||
"Hook run after executing successful operation in Guix REPL.")
|
||||
|
||||
(defvar guix-repl-operation-p nil
|
||||
"Non-nil, if current operation is performed by `guix-eval-in-repl'.
|
||||
This internal variable is used to distinguish Guix operations
|
||||
from operations performed in Guix REPL by a user.")
|
||||
|
||||
(defvar guix-repl-operation-type nil
|
||||
"Type of the current operation performed by `guix-eval-in-repl'.
|
||||
This internal variable is used to define what actions should be
|
||||
executed after the current operation succeeds.
|
||||
See `guix-eval-in-repl' for details.")
|
||||
|
||||
(defun guix-repl-autoload-emacs-packages-maybe ()
|
||||
"Load autoloads for Emacs packages if needed.
|
||||
See `guix-emacs-activate-after-operation' for details."
|
||||
(and guix-emacs-activate-after-operation
|
||||
;; FIXME Since a user can work with a non-current profile (using
|
||||
;; C-u before `guix-search-by-name' and other commands), emacs
|
||||
;; packages can be installed to another profile, and the
|
||||
;; following code will not work (i.e., the autoloads for this
|
||||
;; profile will not be loaded).
|
||||
(guix-emacs-autoload-packages guix-current-profile)))
|
||||
|
||||
(defun guix-repl-operation-success-message ()
|
||||
"Message telling about successful Guix operation."
|
||||
(message "Guix operation has been performed."))
|
||||
|
||||
(defun guix-get-guile-program (&optional socket)
|
||||
"Return a value suitable for `geiser-guile-binary'."
|
||||
(if (null socket)
|
||||
guix-guile-program
|
||||
(append (if (listp guix-guile-program)
|
||||
guix-guile-program
|
||||
(list guix-guile-program))
|
||||
(list (concat "--listen=" socket)))))
|
||||
|
||||
(defun guix-repl-socket-file-name ()
|
||||
"Return a name of a socket file used by Guix REPL."
|
||||
(make-temp-name
|
||||
(concat (file-name-as-directory temporary-file-directory)
|
||||
"guix-repl-")))
|
||||
|
||||
(defun guix-repl-delete-socket-maybe ()
|
||||
"Delete `guix-repl-current-socket' file if it exists."
|
||||
(and guix-repl-current-socket
|
||||
(file-exists-p guix-repl-current-socket)
|
||||
(delete-file guix-repl-current-socket)))
|
||||
|
||||
(add-hook 'kill-emacs-hook 'guix-repl-delete-socket-maybe)
|
||||
|
||||
(defun guix-start-process-maybe (&optional start-msg end-msg)
|
||||
"Start Geiser REPL configured for Guix if needed.
|
||||
START-MSG and END-MSG are strings displayed in the minibuffer in
|
||||
the beginning and in the end of the starting process. If nil,
|
||||
display default messages."
|
||||
(guix-start-repl-maybe nil
|
||||
(or start-msg "Starting Guix REPL ...")
|
||||
(or end-msg "Guix REPL has been started."))
|
||||
(if guix-use-guile-server
|
||||
(guix-start-repl-maybe 'internal)
|
||||
(setq guix-internal-repl-buffer guix-repl-buffer)))
|
||||
|
||||
(defun guix-start-repl-maybe (&optional internal start-msg end-msg)
|
||||
"Start Guix REPL if needed.
|
||||
If INTERNAL is non-nil, start an internal REPL.
|
||||
|
||||
START-MSG and END-MSG are strings displayed in the minibuffer in
|
||||
the beginning and in the end of the process. If nil, do not
|
||||
display messages."
|
||||
(let* ((repl-var (guix-get-repl-buffer-variable internal))
|
||||
(repl (symbol-value repl-var)))
|
||||
(unless (and (buffer-live-p repl)
|
||||
(get-buffer-process repl))
|
||||
(and start-msg (message start-msg))
|
||||
(setq guix-repl-operation-p nil)
|
||||
(unless internal
|
||||
;; Guile leaves socket file after exit, so remove it if it
|
||||
;; exists (after the REPL restart).
|
||||
(guix-repl-delete-socket-maybe)
|
||||
(setq guix-repl-current-socket
|
||||
(and guix-use-guile-server
|
||||
(or guix-repl-current-socket
|
||||
(funcall guix-repl-socket-file-name-function)))))
|
||||
(let ((geiser-guile-binary (guix-get-guile-program
|
||||
(unless internal
|
||||
guix-repl-current-socket)))
|
||||
(geiser-guile-init-file (unless internal guix-helper-file))
|
||||
(repl (get-buffer-create
|
||||
(guix-get-repl-buffer-name internal))))
|
||||
(guix-start-repl repl (and internal guix-repl-current-socket))
|
||||
(set repl-var repl)
|
||||
(and end-msg (message end-msg))
|
||||
(unless internal
|
||||
(run-hooks 'guix-after-start-repl-hook))))))
|
||||
|
||||
(defun guix-start-repl (buffer &optional address)
|
||||
"Start Guix REPL in BUFFER.
|
||||
If ADDRESS is non-nil, connect to a remote guile process using
|
||||
this address (it should be defined by
|
||||
`geiser-repl--read-address')."
|
||||
;; A mix of the code from `geiser-repl--start-repl' and
|
||||
;; `geiser-repl--to-repl-buffer'.
|
||||
(let ((impl 'guile)
|
||||
(geiser-guile-load-path (cons (expand-file-name guix-load-path)
|
||||
geiser-guile-load-path))
|
||||
(geiser-repl-startup-time guix-repl-startup-time))
|
||||
(with-current-buffer buffer
|
||||
(geiser-repl-mode)
|
||||
(geiser-impl--set-buffer-implementation impl)
|
||||
(geiser-repl--autodoc-mode -1)
|
||||
(goto-char (point-max))
|
||||
(let ((prompt (geiser-con--combined-prompt
|
||||
geiser-guile--prompt-regexp
|
||||
geiser-guile--debugger-prompt-regexp)))
|
||||
(geiser-repl--save-remote-data address)
|
||||
(geiser-repl--start-scheme impl address prompt)
|
||||
(geiser-repl--quit-setup)
|
||||
(geiser-repl--history-setup)
|
||||
(setq-local geiser-repl--repls (list buffer))
|
||||
(geiser-repl--set-this-buffer-repl buffer)
|
||||
(setq geiser-repl--connection
|
||||
(geiser-con--make-connection
|
||||
(get-buffer-process (current-buffer))
|
||||
geiser-guile--prompt-regexp
|
||||
geiser-guile--debugger-prompt-regexp))
|
||||
(geiser-repl--startup impl address)
|
||||
(geiser-repl--autodoc-mode 1)
|
||||
(geiser-company--setup geiser-repl-company-p)
|
||||
(add-hook 'comint-output-filter-functions
|
||||
'guix-repl-output-filter
|
||||
nil t)
|
||||
(set-process-query-on-exit-flag
|
||||
(get-buffer-process (current-buffer))
|
||||
geiser-repl-query-on-kill-p)))))
|
||||
|
||||
(defun guix-repl-output-filter (str)
|
||||
"Filter function suitable for `comint-output-filter-functions'.
|
||||
This is a replacement for `geiser-repl--output-filter'."
|
||||
(cond
|
||||
((string-match-p geiser-guile--prompt-regexp str)
|
||||
(geiser-autodoc--disinhibit-autodoc)
|
||||
(when guix-repl-operation-p
|
||||
(setq guix-repl-operation-p nil)
|
||||
(run-hooks 'guix-after-repl-operation-hook)
|
||||
;; Run hooks specific to the current operation type.
|
||||
(when guix-repl-operation-type
|
||||
(let ((type-hook (intern
|
||||
(concat "guix-after-"
|
||||
(symbol-name guix-repl-operation-type)
|
||||
"-hook"))))
|
||||
(setq guix-repl-operation-type nil)
|
||||
(and (boundp type-hook)
|
||||
(run-hooks type-hook))))))
|
||||
((string-match geiser-guile--debugger-prompt-regexp str)
|
||||
(setq guix-repl-operation-p nil)
|
||||
(geiser-con--connection-set-debugging geiser-repl--connection
|
||||
(match-beginning 0))
|
||||
(geiser-autodoc--disinhibit-autodoc))))
|
||||
|
||||
(defun guix-repl-exit (&optional internal no-wait)
|
||||
"Exit the current Guix REPL.
|
||||
If INTERNAL is non-nil, exit the internal REPL.
|
||||
If NO-WAIT is non-nil, do not wait for the REPL process to exit:
|
||||
send a kill signal to it and return immediately."
|
||||
(let ((repl (symbol-value (guix-get-repl-buffer-variable internal))))
|
||||
(when (get-buffer-process repl)
|
||||
(with-current-buffer repl
|
||||
(geiser-con--connection-deactivate geiser-repl--connection t)
|
||||
(comint-kill-subjob)
|
||||
(unless no-wait
|
||||
(while (get-buffer-process repl)
|
||||
(sleep-for 0.1)))))))
|
||||
|
||||
(defun guix-get-repl-buffer (&optional internal)
|
||||
"Return Guix REPL buffer; start REPL if needed.
|
||||
If INTERNAL is non-nil, return an additional internal REPL."
|
||||
(guix-start-process-maybe)
|
||||
(let ((repl (symbol-value (guix-get-repl-buffer-variable internal))))
|
||||
;; If a new Geiser REPL is started, `geiser-repl--repl' variable may
|
||||
;; be set to the new value in a Guix REPL, so set it back to a
|
||||
;; proper value here.
|
||||
(with-current-buffer repl
|
||||
(geiser-repl--set-this-buffer-repl repl))
|
||||
repl))
|
||||
|
||||
(defun guix-get-repl-buffer-variable (&optional internal)
|
||||
"Return the name of a variable with a REPL buffer."
|
||||
(if internal
|
||||
'guix-internal-repl-buffer
|
||||
'guix-repl-buffer))
|
||||
|
||||
(defun guix-get-repl-buffer-name (&optional internal)
|
||||
"Return the name of a REPL buffer."
|
||||
(if internal
|
||||
guix-internal-repl-buffer-name
|
||||
guix-repl-buffer-name))
|
||||
|
||||
(defun guix-switch-to-repl (&optional internal)
|
||||
"Switch to Guix REPL.
|
||||
If INTERNAL is non-nil (interactively with prefix), switch to the
|
||||
additional internal REPL if it exists."
|
||||
(interactive "P")
|
||||
(geiser-repl--switch-to-buffer (guix-get-repl-buffer internal)))
|
||||
|
||||
|
||||
;;; Guix directory
|
||||
|
||||
(defvar guix-directory nil
|
||||
"Default directory with Guix source.
|
||||
If it is not set by a user, it is set after starting Guile REPL.
|
||||
This directory is used to define package locations.")
|
||||
|
||||
(defun guix-read-directory ()
|
||||
"Return `guix-directory' or prompt for it.
|
||||
This function is intended for using in `interactive' forms."
|
||||
(if current-prefix-arg
|
||||
(read-directory-name "Directory with Guix modules: "
|
||||
guix-directory)
|
||||
guix-directory))
|
||||
|
||||
(defun guix-set-directory ()
|
||||
"Set `guix-directory' if needed."
|
||||
(or guix-directory
|
||||
(setq guix-directory
|
||||
(guix-eval-read "%guix-dir"))))
|
||||
|
||||
|
||||
;;; Evaluating expressions
|
||||
|
||||
(defvar guix-operation-buffer nil
|
||||
"Buffer from which the latest Guix operation was performed.")
|
||||
|
||||
(defun guix-eval (str)
|
||||
"Evaluate STR with guile expression using Guix REPL.
|
||||
See `guix-geiser-eval' for details."
|
||||
(guix-geiser-eval str (guix-get-repl-buffer 'internal)))
|
||||
|
||||
(defun guix-eval-read (str)
|
||||
"Evaluate STR with guile expression using Guix REPL.
|
||||
See `guix-geiser-eval-read' for details."
|
||||
(guix-geiser-eval-read str (guix-get-repl-buffer 'internal)))
|
||||
|
||||
(defun guix-eval-in-repl (str &optional operation-buffer operation-type)
|
||||
"Switch to Guix REPL and evaluate STR with guile expression there.
|
||||
If OPERATION-BUFFER is non-nil, it should be a buffer from which
|
||||
the current operation was performed.
|
||||
|
||||
If OPERATION-TYPE is non-nil, it should be a symbol. After
|
||||
successful executing of the current operation,
|
||||
`guix-after-OPERATION-TYPE-hook' is called."
|
||||
(run-hooks 'guix-before-repl-operation-hook)
|
||||
(setq guix-repl-operation-p t
|
||||
guix-repl-operation-type operation-type
|
||||
guix-operation-buffer operation-buffer)
|
||||
(guix-geiser-eval-in-repl str (guix-get-repl-buffer)))
|
||||
|
||||
(provide 'guix-backend)
|
||||
|
||||
;;; guix-backend.el ends here
|
||||
@@ -1,377 +0,0 @@
|
||||
;;; guix-base.el --- Common definitions -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides some base and common definitions for guix.el
|
||||
;; package.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'guix-backend)
|
||||
(require 'guix-guile)
|
||||
(require 'guix-read)
|
||||
(require 'guix-utils)
|
||||
(require 'guix-ui)
|
||||
(require 'guix-profiles)
|
||||
|
||||
(defgroup guix nil
|
||||
"Settings for Guix package manager and friends."
|
||||
:prefix "guix-"
|
||||
:group 'external)
|
||||
|
||||
(defgroup guix-faces nil
|
||||
"Guix faces."
|
||||
:group 'guix
|
||||
:group 'faces)
|
||||
|
||||
(defun guix-package-name-specification (name version &optional output)
|
||||
"Return Guix package specification by its NAME, VERSION and OUTPUT."
|
||||
(concat name "@" version
|
||||
(when output (concat ":" output))))
|
||||
|
||||
|
||||
;;; Location of profiles and manifests
|
||||
|
||||
(defun guix-generation-file (profile generation)
|
||||
"Return the file name of a PROFILE's GENERATION."
|
||||
(format "%s-%s-link" profile generation))
|
||||
|
||||
(defun guix-packages-profile (profile &optional generation system?)
|
||||
"Return a directory where packages are installed for the
|
||||
PROFILE's GENERATION.
|
||||
|
||||
If SYSTEM? is non-nil, then PROFILE is considered to be a system
|
||||
profile. Unlike usual profiles, for a system profile, packages
|
||||
are placed in 'profile' subdirectory."
|
||||
(let ((profile (if generation
|
||||
(guix-generation-file profile generation)
|
||||
profile)))
|
||||
(if system?
|
||||
(expand-file-name "profile" profile)
|
||||
profile)))
|
||||
|
||||
(defun guix-manifest-file (profile &optional generation system?)
|
||||
"Return the file name of a PROFILE's manifest.
|
||||
See `guix-packages-profile'."
|
||||
(expand-file-name "manifest"
|
||||
(guix-packages-profile profile generation system?)))
|
||||
|
||||
|
||||
;;; Actions on packages and generations
|
||||
|
||||
(defface guix-operation-option-key
|
||||
'((t :inherit font-lock-warning-face))
|
||||
"Face used for the keys of operation options."
|
||||
:group 'guix-faces)
|
||||
|
||||
(defcustom guix-operation-confirm t
|
||||
"If nil, do not prompt to confirm an operation."
|
||||
:type 'boolean
|
||||
:group 'guix)
|
||||
|
||||
(defcustom guix-use-substitutes t
|
||||
"If non-nil, use substitutes for the Guix packages."
|
||||
:type 'boolean
|
||||
:group 'guix)
|
||||
|
||||
(defvar guix-dry-run nil
|
||||
"If non-nil, do not perform the real actions, just simulate.")
|
||||
|
||||
(defvar guix-temp-buffer-name " *Guix temp*"
|
||||
"Name of a buffer used for displaying info before executing operation.")
|
||||
|
||||
(defvar guix-operation-option-true-string "yes"
|
||||
"String displayed in the mode-line when operation option is t.")
|
||||
|
||||
(defvar guix-operation-option-false-string "no "
|
||||
"String displayed in the mode-line when operation option is nil.")
|
||||
|
||||
(defvar guix-operation-option-separator " | "
|
||||
"String used in the mode-line to separate operation options.")
|
||||
|
||||
(defvar guix-operation-options
|
||||
'((?s "substitutes" guix-use-substitutes)
|
||||
(?d "dry-run" guix-dry-run))
|
||||
"List of available operation options.
|
||||
Each element of the list has a form:
|
||||
|
||||
(KEY NAME VARIABLE)
|
||||
|
||||
KEY is a character that may be pressed during confirmation to
|
||||
toggle the option.
|
||||
NAME is a string displayed in the mode-line.
|
||||
VARIABLE is a name of an option variable.")
|
||||
|
||||
(defun guix-operation-option-by-key (key)
|
||||
"Return operation option by KEY (character)."
|
||||
(assq key guix-operation-options))
|
||||
|
||||
(defun guix-operation-option-key (option)
|
||||
"Return key (character) of the operation OPTION."
|
||||
(car option))
|
||||
|
||||
(defun guix-operation-option-name (option)
|
||||
"Return name of the operation OPTION."
|
||||
(nth 1 option))
|
||||
|
||||
(defun guix-operation-option-variable (option)
|
||||
"Return name of the variable of the operation OPTION."
|
||||
(nth 2 option))
|
||||
|
||||
(defun guix-operation-option-value (option)
|
||||
"Return boolean value of the operation OPTION."
|
||||
(symbol-value (guix-operation-option-variable option)))
|
||||
|
||||
(defun guix-operation-option-string-value (option)
|
||||
"Convert boolean value of the operation OPTION to string and return it."
|
||||
(if (guix-operation-option-value option)
|
||||
guix-operation-option-true-string
|
||||
guix-operation-option-false-string))
|
||||
|
||||
(defun guix-operation-prompt (&optional prompt)
|
||||
"Prompt a user for continuing the current operation.
|
||||
Return non-nil, if the operation should be continued; nil otherwise.
|
||||
Ask a user with PROMPT for continuing an operation."
|
||||
(let* ((option-keys (mapcar #'guix-operation-option-key
|
||||
guix-operation-options))
|
||||
(keys (append '(?y ?n) option-keys))
|
||||
(prompt (concat (propertize (or prompt "Continue operation?")
|
||||
'face 'minibuffer-prompt)
|
||||
" ("
|
||||
(mapconcat
|
||||
(lambda (key)
|
||||
(propertize (string key)
|
||||
'face 'guix-operation-option-key))
|
||||
keys
|
||||
", ")
|
||||
") ")))
|
||||
(let ((mode-line mode-line-format))
|
||||
(prog1 (guix-operation-prompt-1 prompt keys)
|
||||
(setq mode-line-format mode-line)
|
||||
;; Clear the minibuffer after prompting.
|
||||
(message "")))))
|
||||
|
||||
(defun guix-operation-prompt-1 (prompt keys)
|
||||
"This function is internal for `guix-operation-prompt'."
|
||||
(guix-operation-set-mode-line)
|
||||
(let ((key (read-char-choice prompt (cons ?\C-g keys) t)))
|
||||
(cl-case key
|
||||
(?y t)
|
||||
((?n ?\C-g) nil)
|
||||
(t (let* ((option (guix-operation-option-by-key key))
|
||||
(var (guix-operation-option-variable option)))
|
||||
(set var (not (symbol-value var)))
|
||||
(guix-operation-prompt-1 prompt keys))))))
|
||||
|
||||
(defun guix-operation-set-mode-line ()
|
||||
"Display operation options in the mode-line of the current buffer."
|
||||
(setq mode-line-format
|
||||
(concat (propertize " Options: "
|
||||
'face 'mode-line-buffer-id)
|
||||
(mapconcat
|
||||
(lambda (option)
|
||||
(let ((key (guix-operation-option-key option))
|
||||
(name (guix-operation-option-name option))
|
||||
(val (guix-operation-option-string-value option)))
|
||||
(concat name
|
||||
" ("
|
||||
(propertize (string key)
|
||||
'face 'guix-operation-option-key)
|
||||
"): " val)))
|
||||
guix-operation-options
|
||||
guix-operation-option-separator)))
|
||||
(force-mode-line-update))
|
||||
|
||||
(defun guix-package-source-path (package-id)
|
||||
"Return a store file path to a source of a package PACKAGE-ID."
|
||||
(message "Calculating the source derivation ...")
|
||||
(guix-eval-read
|
||||
(guix-make-guile-expression
|
||||
'package-source-path package-id)))
|
||||
|
||||
(defun guix-package-store-path (package-id)
|
||||
"Return a list of store directories of outputs of package PACKAGE-ID."
|
||||
(message "Calculating the package derivation ...")
|
||||
(guix-eval-read
|
||||
(guix-make-guile-expression
|
||||
'package-store-path package-id)))
|
||||
|
||||
(defvar guix-after-source-download-hook nil
|
||||
"Hook run after successful performing a 'source-download' operation.")
|
||||
|
||||
(defun guix-package-source-build-derivation (package-id &optional prompt)
|
||||
"Build source derivation of a package PACKAGE-ID.
|
||||
Ask a user with PROMPT for continuing an operation."
|
||||
(when (or (not guix-operation-confirm)
|
||||
(guix-operation-prompt (or prompt
|
||||
"Build the source derivation?")))
|
||||
(guix-eval-in-repl
|
||||
(guix-make-guile-expression
|
||||
'package-source-build-derivation
|
||||
package-id
|
||||
:use-substitutes? (or guix-use-substitutes 'f)
|
||||
:dry-run? (or guix-dry-run 'f))
|
||||
nil 'source-download)))
|
||||
|
||||
(defun guix-build-package (package-id &optional prompt)
|
||||
"Build package with PACKAGE-ID.
|
||||
Ask a user with PROMPT for continuing the build operation."
|
||||
(when (or (not guix-operation-confirm)
|
||||
(guix-operation-prompt (or prompt "Build package?")))
|
||||
(guix-eval-in-repl
|
||||
(format (concat ",run-in-store "
|
||||
"(build-package (package-by-id %d)"
|
||||
" #:use-substitutes? %s"
|
||||
" #:dry-run? %s)")
|
||||
package-id
|
||||
(guix-guile-boolean guix-use-substitutes)
|
||||
(guix-guile-boolean guix-dry-run)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun guix-apply-manifest (profile file &optional operation-buffer)
|
||||
"Apply manifest from FILE to PROFILE.
|
||||
This function has the same meaning as 'guix package --manifest' command.
|
||||
See Info node `(guix) Invoking guix package' for details.
|
||||
|
||||
Interactively, use the current profile and prompt for manifest
|
||||
FILE. With a prefix argument, also prompt for PROFILE."
|
||||
(interactive
|
||||
(let* ((current-profile (guix-ui-current-profile))
|
||||
(profile (if current-prefix-arg
|
||||
(guix-profile-prompt)
|
||||
(or current-profile guix-current-profile)))
|
||||
(file (read-file-name "File with manifest: "))
|
||||
(buffer (and current-profile (current-buffer))))
|
||||
(list profile file buffer)))
|
||||
(when (or (not guix-operation-confirm)
|
||||
(y-or-n-p (format "Apply manifest from '%s' to profile '%s'? "
|
||||
file profile)))
|
||||
(guix-eval-in-repl
|
||||
(guix-make-guile-expression
|
||||
'guix-command
|
||||
"package"
|
||||
(concat "--profile=" (expand-file-name profile))
|
||||
(concat "--manifest=" (expand-file-name file)))
|
||||
operation-buffer)))
|
||||
|
||||
|
||||
;;; Executing guix commands
|
||||
|
||||
(defcustom guix-run-in-shell-function #'guix-run-in-shell
|
||||
"Function used to run guix command.
|
||||
The function is called with a single argument - a command line string."
|
||||
:type '(choice (function-item guix-run-in-shell)
|
||||
(function-item guix-run-in-eshell)
|
||||
(function :tag "Other function"))
|
||||
:group 'guix)
|
||||
|
||||
(defcustom guix-shell-buffer-name "*shell*"
|
||||
"Default name of a shell buffer used for running guix commands."
|
||||
:type 'string
|
||||
:group 'guix)
|
||||
|
||||
(declare-function comint-send-input "comint" t)
|
||||
|
||||
(defun guix-run-in-shell (string)
|
||||
"Run command line STRING in `guix-shell-buffer-name' buffer."
|
||||
(shell guix-shell-buffer-name)
|
||||
(goto-char (point-max))
|
||||
(insert string)
|
||||
(comint-send-input))
|
||||
|
||||
(declare-function eshell-send-input "esh-mode" t)
|
||||
|
||||
(defun guix-run-in-eshell (string)
|
||||
"Run command line STRING in eshell buffer."
|
||||
(eshell)
|
||||
(goto-char (point-max))
|
||||
(insert string)
|
||||
(eshell-send-input))
|
||||
|
||||
(defun guix-run-command-in-shell (args)
|
||||
"Execute 'guix ARGS ...' command in a shell buffer."
|
||||
(funcall guix-run-in-shell-function
|
||||
(guix-command-string args)))
|
||||
|
||||
(defun guix-run-command-in-repl (args)
|
||||
"Execute 'guix ARGS ...' command in Guix REPL."
|
||||
(guix-eval-in-repl
|
||||
(apply #'guix-make-guile-expression
|
||||
'guix-command args)))
|
||||
|
||||
(defun guix-command-output (args)
|
||||
"Return string with 'guix ARGS ...' output."
|
||||
(cl-multiple-value-bind (output error)
|
||||
(guix-eval (apply #'guix-make-guile-expression
|
||||
'guix-command-output args))
|
||||
;; Remove trailing new space from the error string.
|
||||
(message (replace-regexp-in-string "\n\\'" "" (read error)))
|
||||
(read output)))
|
||||
|
||||
(defun guix-help-string (&optional commands)
|
||||
"Return string with 'guix COMMANDS ... --help' output."
|
||||
(guix-eval-read
|
||||
(apply #'guix-make-guile-expression
|
||||
'help-string commands)))
|
||||
|
||||
|
||||
;;; Pull
|
||||
|
||||
(defcustom guix-update-after-pull t
|
||||
"If non-nil, update Guix buffers after performing \\[guix-pull]."
|
||||
:type 'boolean
|
||||
:group 'guix)
|
||||
|
||||
(defvar guix-after-pull-hook
|
||||
'(guix-restart-repl-after-pull guix-update-buffers-maybe-after-pull)
|
||||
"Hook run after successful performing `guix-pull' operation.")
|
||||
|
||||
(defun guix-restart-repl-after-pull ()
|
||||
"Restart Guix REPL after `guix-pull' operation."
|
||||
(guix-repl-exit)
|
||||
(guix-start-process-maybe
|
||||
"Restarting Guix REPL after pull operation ..."))
|
||||
|
||||
(defun guix-update-buffers-maybe-after-pull ()
|
||||
"Update buffers depending on `guix-update-after-pull'."
|
||||
(when guix-update-after-pull
|
||||
(mapc #'guix-ui-update-buffer
|
||||
;; No need to update "generation" buffers.
|
||||
(guix-ui-buffers '(guix-package-list-mode
|
||||
guix-package-info-mode
|
||||
guix-output-list-mode
|
||||
guix-output-info-mode)))
|
||||
(message "Guix buffers have been updated.")))
|
||||
|
||||
;;;###autoload
|
||||
(defun guix-pull (&optional verbose)
|
||||
"Run Guix pull operation.
|
||||
If VERBOSE is non-nil (with prefix argument), produce verbose output."
|
||||
(interactive "P")
|
||||
(let ((args (and verbose '("--verbose"))))
|
||||
(guix-eval-in-repl
|
||||
(apply #'guix-make-guile-expression
|
||||
'guix-command "pull" args)
|
||||
nil 'pull)))
|
||||
|
||||
(provide 'guix-base)
|
||||
|
||||
;;; guix-base.el ends here
|
||||
@@ -1,624 +0,0 @@
|
||||
;;; guix-buffer.el --- Buffer interface for displaying data -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides a general 'buffer' interface for displaying an
|
||||
;; arbitrary data.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'guix-history)
|
||||
(require 'guix-utils)
|
||||
|
||||
(defvar guix-buffer-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map (kbd "l") 'guix-history-back)
|
||||
(define-key map (kbd "r") 'guix-history-forward)
|
||||
(define-key map (kbd "g") 'revert-buffer)
|
||||
(define-key map (kbd "R") 'guix-buffer-redisplay)
|
||||
map)
|
||||
"Parent keymap for Guix buffer modes.")
|
||||
|
||||
|
||||
;;; Buffer item
|
||||
|
||||
(cl-defstruct (guix-buffer-item
|
||||
(:constructor nil)
|
||||
(:constructor guix-buffer-make-item
|
||||
(entries buffer-type entry-type args))
|
||||
(:copier nil))
|
||||
entries buffer-type entry-type args)
|
||||
|
||||
(defvar-local guix-buffer-item nil
|
||||
"Data (structure) for the current Guix buffer.
|
||||
The structure consists of the following elements:
|
||||
|
||||
- `entries': list of the currently displayed entries.
|
||||
|
||||
Each element of the list is an alist with an entry data of the
|
||||
following form:
|
||||
|
||||
((PARAM . VAL) ...)
|
||||
|
||||
PARAM is a name of the entry parameter.
|
||||
VAL is a value of this parameter.
|
||||
|
||||
- `entry-type': type of the currently displayed entries.
|
||||
|
||||
- `buffer-type': type of the current buffer.
|
||||
|
||||
- `args': search arguments used to get the current entries.")
|
||||
(put 'guix-buffer-item 'permanent-local t)
|
||||
|
||||
(defmacro guix-buffer-with-item (item &rest body)
|
||||
"Evaluate BODY using buffer ITEM.
|
||||
The following local variables are available inside BODY:
|
||||
`%entries', `%buffer-type', `%entry-type', `%args'.
|
||||
See `guix-buffer-item' for details."
|
||||
(declare (indent 1) (debug t))
|
||||
(let ((item-var (make-symbol "item")))
|
||||
`(let ((,item-var ,item))
|
||||
(let ((%entries (guix-buffer-item-entries ,item-var))
|
||||
(%buffer-type (guix-buffer-item-buffer-type ,item-var))
|
||||
(%entry-type (guix-buffer-item-entry-type ,item-var))
|
||||
(%args (guix-buffer-item-args ,item-var)))
|
||||
,@body))))
|
||||
|
||||
(defmacro guix-buffer-with-current-item (&rest body)
|
||||
"Evaluate BODY using `guix-buffer-item'.
|
||||
See `guix-buffer-with-item' for details."
|
||||
(declare (indent 0) (debug t))
|
||||
`(guix-buffer-with-item guix-buffer-item
|
||||
,@body))
|
||||
|
||||
(defmacro guix-buffer-define-current-item-accessor (name)
|
||||
"Define `guix-buffer-current-NAME' function to access NAME
|
||||
element of `guix-buffer-item' structure.
|
||||
NAME should be a symbol."
|
||||
(let* ((name-str (symbol-name name))
|
||||
(accessor (intern (concat "guix-buffer-item-" name-str)))
|
||||
(fun-name (intern (concat "guix-buffer-current-" name-str)))
|
||||
(doc (format "\
|
||||
Return '%s' of the current Guix buffer.
|
||||
See `guix-buffer-item' for details."
|
||||
name-str)))
|
||||
`(defun ,fun-name ()
|
||||
,doc
|
||||
(and guix-buffer-item
|
||||
(,accessor guix-buffer-item)))))
|
||||
|
||||
(defmacro guix-buffer-define-current-item-accessors (&rest names)
|
||||
"Define `guix-buffer-current-NAME' functions for NAMES.
|
||||
See `guix-buffer-define-current-item-accessor' for details."
|
||||
`(progn
|
||||
,@(mapcar (lambda (name)
|
||||
`(guix-buffer-define-current-item-accessor ,name))
|
||||
names)))
|
||||
|
||||
(guix-buffer-define-current-item-accessors
|
||||
entries entry-type buffer-type args)
|
||||
|
||||
(defmacro guix-buffer-define-current-args-accessor (n prefix name)
|
||||
"Define `PREFIX-NAME' function to access Nth element of 'args'
|
||||
field of `guix-buffer-item' structure.
|
||||
PREFIX and NAME should be strings."
|
||||
(let ((fun-name (intern (concat prefix "-" name)))
|
||||
(doc (format "\
|
||||
Return '%s' of the current Guix buffer.
|
||||
'%s' is the element number %d in 'args' of `guix-buffer-item'."
|
||||
name name n)))
|
||||
`(defun ,fun-name ()
|
||||
,doc
|
||||
(nth ,n (guix-buffer-current-args)))))
|
||||
|
||||
(defmacro guix-buffer-define-current-args-accessors (prefix &rest names)
|
||||
"Define `PREFIX-NAME' functions for NAMES.
|
||||
See `guix-buffer-define-current-args-accessor' for details."
|
||||
`(progn
|
||||
,@(cl-loop for name in names
|
||||
for i from 0
|
||||
collect `(guix-buffer-define-current-args-accessor
|
||||
,i ,prefix ,name))))
|
||||
|
||||
|
||||
;;; Wrappers for defined variables
|
||||
|
||||
(defvar guix-buffer-data nil
|
||||
"Alist with 'buffer' data.
|
||||
This alist is filled by `guix-buffer-define-interface' macro.")
|
||||
|
||||
(defun guix-buffer-value (buffer-type entry-type symbol)
|
||||
"Return SYMBOL's value for BUFFER-TYPE/ENTRY-TYPE from `guix-buffer-data'."
|
||||
(symbol-value
|
||||
(guix-assq-value guix-buffer-data buffer-type entry-type symbol)))
|
||||
|
||||
(defun guix-buffer-get-entries (buffer-type entry-type args)
|
||||
"Return ENTRY-TYPE entries.
|
||||
Call an appropriate 'get-entries' function from `guix-buffer'
|
||||
using ARGS as its arguments."
|
||||
(apply (guix-buffer-value buffer-type entry-type 'get-entries)
|
||||
args))
|
||||
|
||||
(defun guix-buffer-mode-enable (buffer-type entry-type)
|
||||
"Turn on major mode to display ENTRY-TYPE ENTRIES in BUFFER-TYPE buffer."
|
||||
(funcall (guix-buffer-value buffer-type entry-type 'mode)))
|
||||
|
||||
(defun guix-buffer-mode-initialize (buffer-type entry-type)
|
||||
"Set up the current BUFFER-TYPE buffer to display ENTRY-TYPE entries."
|
||||
(let ((fun (guix-buffer-value buffer-type entry-type 'mode-init)))
|
||||
(when fun
|
||||
(funcall fun))))
|
||||
|
||||
(defun guix-buffer-insert-entries (entries buffer-type entry-type)
|
||||
"Show ENTRY-TYPE ENTRIES in the current BUFFER-TYPE buffer."
|
||||
(funcall (guix-buffer-value buffer-type entry-type 'insert-entries)
|
||||
entries))
|
||||
|
||||
(defun guix-buffer-show-entries-default (entries buffer-type entry-type)
|
||||
"Show ENTRY-TYPE ENTRIES in the current BUFFER-TYPE buffer."
|
||||
(let ((inhibit-read-only t))
|
||||
(erase-buffer)
|
||||
(guix-buffer-mode-enable buffer-type entry-type)
|
||||
(guix-buffer-insert-entries entries buffer-type entry-type)
|
||||
(goto-char (point-min))))
|
||||
|
||||
(defun guix-buffer-show-entries (entries buffer-type entry-type)
|
||||
"Show ENTRY-TYPE ENTRIES in the current BUFFER-TYPE buffer."
|
||||
(funcall (guix-buffer-value buffer-type entry-type 'show-entries)
|
||||
entries))
|
||||
|
||||
(defun guix-buffer-message (entries buffer-type entry-type args)
|
||||
"Display a message for BUFFER-ITEM after showing entries."
|
||||
(let ((fun (guix-buffer-value buffer-type entry-type 'message)))
|
||||
(when fun
|
||||
(apply fun entries args))))
|
||||
|
||||
(defun guix-buffer-name (buffer-type entry-type args)
|
||||
"Return name of BUFFER-TYPE buffer for displaying ENTRY-TYPE entries."
|
||||
(let ((str-or-fun (guix-buffer-value buffer-type entry-type
|
||||
'buffer-name)))
|
||||
(if (stringp str-or-fun)
|
||||
str-or-fun
|
||||
(apply str-or-fun args))))
|
||||
|
||||
(defun guix-buffer-param-title (buffer-type entry-type param)
|
||||
"Return PARAM title for BUFFER-TYPE/ENTRY-TYPE."
|
||||
(or (guix-assq-value (guix-buffer-value buffer-type entry-type 'titles)
|
||||
param)
|
||||
;; Fallback to a title defined in 'info' interface.
|
||||
(unless (eq buffer-type 'info)
|
||||
(guix-assq-value (guix-buffer-value 'info entry-type 'titles)
|
||||
param))
|
||||
(guix-symbol-title param)))
|
||||
|
||||
(defun guix-buffer-history-size (buffer-type entry-type)
|
||||
"Return history size for BUFFER-TYPE/ENTRY-TYPE."
|
||||
(guix-buffer-value buffer-type entry-type 'history-size))
|
||||
|
||||
(defun guix-buffer-revert-confirm? (buffer-type entry-type)
|
||||
"Return 'revert-confirm' value for BUFFER-TYPE/ENTRY-TYPE."
|
||||
(guix-buffer-value buffer-type entry-type 'revert-confirm))
|
||||
|
||||
|
||||
;;; Displaying entries
|
||||
|
||||
(defun guix-buffer-display (buffer)
|
||||
"Switch to a Guix BUFFER."
|
||||
(pop-to-buffer buffer
|
||||
'((display-buffer-reuse-window
|
||||
display-buffer-same-window))))
|
||||
|
||||
(defun guix-buffer-history-item (buffer-item)
|
||||
"Make and return a history item for displaying BUFFER-ITEM."
|
||||
(list #'guix-buffer-set buffer-item))
|
||||
|
||||
(defun guix-buffer-set (buffer-item &optional history)
|
||||
"Set up the current buffer for displaying BUFFER-ITEM.
|
||||
HISTORY should be one of the following:
|
||||
|
||||
`nil' - do not save BUFFER-ITEM in history,
|
||||
|
||||
`add' - add it to history,
|
||||
|
||||
`replace' - replace the current history item."
|
||||
(guix-buffer-with-item buffer-item
|
||||
(when %entries
|
||||
;; Set buffer item before showing entries, so that its value can
|
||||
;; be used by the code for displaying entries.
|
||||
(setq guix-buffer-item buffer-item)
|
||||
(guix-buffer-show-entries %entries %buffer-type %entry-type)
|
||||
(when history
|
||||
(funcall (cl-ecase history
|
||||
(add #'guix-history-add)
|
||||
(replace #'guix-history-replace))
|
||||
(guix-buffer-history-item buffer-item))))
|
||||
(guix-buffer-message %entries %buffer-type %entry-type %args)))
|
||||
|
||||
(defun guix-buffer-display-entries-current
|
||||
(entries buffer-type entry-type args &optional history)
|
||||
"Show ENTRIES in the current Guix buffer.
|
||||
See `guix-buffer-item' for the meaning of BUFFER-TYPE, ENTRY-TYPE
|
||||
and ARGS, and `guix-buffer-set' for the meaning of HISTORY."
|
||||
(let ((item (guix-buffer-make-item entries buffer-type
|
||||
entry-type args)))
|
||||
(guix-buffer-set item history)))
|
||||
|
||||
(defun guix-buffer-get-display-entries-current
|
||||
(buffer-type entry-type args &optional history)
|
||||
"Search for entries and show them in the current Guix buffer.
|
||||
See `guix-buffer-display-entries-current' for details."
|
||||
(guix-buffer-display-entries-current
|
||||
(guix-buffer-get-entries buffer-type entry-type args)
|
||||
buffer-type entry-type args history))
|
||||
|
||||
(defun guix-buffer-display-entries
|
||||
(entries buffer-type entry-type args &optional history)
|
||||
"Show ENTRIES in a BUFFER-TYPE buffer.
|
||||
See `guix-buffer-display-entries-current' for details."
|
||||
(let ((buffer (get-buffer-create
|
||||
(guix-buffer-name buffer-type entry-type args))))
|
||||
(with-current-buffer buffer
|
||||
(guix-buffer-display-entries-current
|
||||
entries buffer-type entry-type args history))
|
||||
(when entries
|
||||
(guix-buffer-display buffer))))
|
||||
|
||||
(defun guix-buffer-get-display-entries
|
||||
(buffer-type entry-type args &optional history)
|
||||
"Search for entries and show them in a BUFFER-TYPE buffer.
|
||||
See `guix-buffer-display-entries-current' for details."
|
||||
(guix-buffer-display-entries
|
||||
(guix-buffer-get-entries buffer-type entry-type args)
|
||||
buffer-type entry-type args history))
|
||||
|
||||
(defun guix-buffer-revert (_ignore-auto noconfirm)
|
||||
"Update the data in the current Guix buffer.
|
||||
This function is suitable for `revert-buffer-function'.
|
||||
See `revert-buffer' for the meaning of NOCONFIRM."
|
||||
(guix-buffer-with-current-item
|
||||
(when (or noconfirm
|
||||
(not (guix-buffer-revert-confirm? %buffer-type %entry-type))
|
||||
(y-or-n-p "Update the current buffer? "))
|
||||
(guix-buffer-get-display-entries-current
|
||||
%buffer-type %entry-type %args 'replace))))
|
||||
|
||||
(defvar guix-buffer-after-redisplay-hook nil
|
||||
"Hook run by `guix-buffer-redisplay'.
|
||||
This hook is called before seting up a window position.")
|
||||
|
||||
(defun guix-buffer-redisplay ()
|
||||
"Redisplay the current Guix buffer.
|
||||
Restore the point and window positions after redisplaying.
|
||||
|
||||
This function does not update the buffer data, use
|
||||
'\\[revert-buffer]' if you want the full update."
|
||||
(interactive)
|
||||
(let* ((old-point (point))
|
||||
;; For simplicity, ignore an unlikely case when multiple
|
||||
;; windows display the same buffer.
|
||||
(window (car (get-buffer-window-list (current-buffer) nil t)))
|
||||
(window-start (and window (window-start window))))
|
||||
(guix-buffer-set guix-buffer-item)
|
||||
(goto-char old-point)
|
||||
(run-hooks 'guix-buffer-after-redisplay-hook)
|
||||
(when window
|
||||
(set-window-point window (point))
|
||||
(set-window-start window window-start))))
|
||||
|
||||
(defun guix-buffer-redisplay-goto-button ()
|
||||
"Redisplay the current buffer and go to the next button, if needed."
|
||||
(let ((guix-buffer-after-redisplay-hook
|
||||
(cons (lambda ()
|
||||
(unless (button-at (point))
|
||||
(forward-button 1)))
|
||||
guix-buffer-after-redisplay-hook)))
|
||||
(guix-buffer-redisplay)))
|
||||
|
||||
|
||||
;;; Interface definers
|
||||
|
||||
(defmacro guix-define-groups (type &rest args)
|
||||
"Define `guix-TYPE' and `guix-TYPE-faces' custom groups.
|
||||
Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
|
||||
|
||||
Optional keywords:
|
||||
|
||||
- `:parent-group' - name of a parent custom group.
|
||||
|
||||
- `:parent-faces-group' - name of a parent custom faces group.
|
||||
|
||||
- `:group-doc' - docstring of a `guix-TYPE' group.
|
||||
|
||||
- `:faces-group-doc' - docstring of a `guix-TYPE-faces' group."
|
||||
(declare (indent 1))
|
||||
(let* ((type-str (symbol-name type))
|
||||
(prefix (concat "guix-" type-str))
|
||||
(group (intern prefix))
|
||||
(faces-group (intern (concat prefix "-faces"))))
|
||||
(guix-keyword-args-let args
|
||||
((parent-group :parent-group 'guix)
|
||||
(parent-faces-group :parent-faces-group 'guix-faces)
|
||||
(group-doc :group-doc
|
||||
(format "Settings for '%s' buffers."
|
||||
type-str))
|
||||
(faces-group-doc :faces-group-doc
|
||||
(format "Faces for '%s' buffers."
|
||||
type-str)))
|
||||
`(progn
|
||||
(defgroup ,group nil
|
||||
,group-doc
|
||||
:group ',parent-group)
|
||||
|
||||
(defgroup ,faces-group nil
|
||||
,faces-group-doc
|
||||
:group ',group
|
||||
:group ',parent-faces-group)))))
|
||||
|
||||
(defmacro guix-define-entry-type (entry-type &rest args)
|
||||
"Define general code for ENTRY-TYPE.
|
||||
See `guix-define-groups'."
|
||||
(declare (indent 1))
|
||||
`(guix-define-groups ,entry-type
|
||||
,@args))
|
||||
|
||||
(defmacro guix-define-buffer-type (buffer-type &rest args)
|
||||
"Define general code for BUFFER-TYPE.
|
||||
See `guix-define-groups'."
|
||||
(declare (indent 1))
|
||||
`(guix-define-groups ,buffer-type
|
||||
,@args))
|
||||
|
||||
(defmacro guix-buffer-define-interface (buffer-type entry-type &rest args)
|
||||
"Define BUFFER-TYPE interface for displaying ENTRY-TYPE entries.
|
||||
Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
|
||||
In the following description TYPE means ENTRY-TYPE-BUFFER-TYPE.
|
||||
|
||||
Required keywords:
|
||||
|
||||
- `:buffer-name' - default value of the generated
|
||||
`guix-TYPE-buffer-name' variable.
|
||||
|
||||
- `:get-entries-function' - default value of the generated
|
||||
`guix-TYPE-get-function' variable.
|
||||
|
||||
- `:show-entries-function' - default value of the generated
|
||||
`guix-TYPE-show-function' variable.
|
||||
|
||||
Alternatively, if `:show-entries-function' is not specified, a
|
||||
default `guix-TYPE-show-entries' will be generated, and the
|
||||
following keyword should be specified instead:
|
||||
|
||||
- `:insert-entries-function' - default value of the generated
|
||||
`guix-TYPE-insert-function' variable.
|
||||
|
||||
Optional keywords:
|
||||
|
||||
- `:message-function' - default value of the generated
|
||||
`guix-TYPE-message-function' variable.
|
||||
|
||||
- `:titles' - default value of the generated
|
||||
`guix-TYPE-titles' variable.
|
||||
|
||||
- `:history-size' - default value of the generated
|
||||
`guix-TYPE-history-size' variable.
|
||||
|
||||
- `:revert-confirm?' - default value of the generated
|
||||
`guix-TYPE-revert-confirm' variable.
|
||||
|
||||
- `:mode-name' - name (a string appeared in the mode-line) of
|
||||
the generated `guix-TYPE-mode'.
|
||||
|
||||
- `:mode-init-function' - default value of the generated
|
||||
`guix-TYPE-mode-initialize-function' variable.
|
||||
|
||||
- `:reduced?' - if non-nil, generate only group, faces group
|
||||
and titles variable (if specified); all keywords become
|
||||
optional."
|
||||
(declare (indent 2))
|
||||
(let* ((entry-type-str (symbol-name entry-type))
|
||||
(buffer-type-str (symbol-name buffer-type))
|
||||
(prefix (concat "guix-" entry-type-str "-"
|
||||
buffer-type-str))
|
||||
(group (intern prefix))
|
||||
(faces-group (intern (concat prefix "-faces")))
|
||||
(get-entries-var (intern (concat prefix "-get-function")))
|
||||
(show-entries-var (intern (concat prefix "-show-function")))
|
||||
(show-entries-fun (intern (concat prefix "-show-entries")))
|
||||
(message-var (intern (concat prefix "-message-function")))
|
||||
(buffer-name-var (intern (concat prefix "-buffer-name")))
|
||||
(titles-var (intern (concat prefix "-titles")))
|
||||
(history-size-var (intern (concat prefix "-history-size")))
|
||||
(revert-confirm-var (intern (concat prefix "-revert-confirm"))))
|
||||
(guix-keyword-args-let args
|
||||
((get-entries-val :get-entries-function)
|
||||
(show-entries-val :show-entries-function)
|
||||
(insert-entries-val :insert-entries-function)
|
||||
(mode-name :mode-name (capitalize prefix))
|
||||
(mode-init-val :mode-init-function)
|
||||
(message-val :message-function)
|
||||
(buffer-name-val :buffer-name)
|
||||
(titles-val :titles)
|
||||
(history-size-val :history-size 20)
|
||||
(revert-confirm-val :revert-confirm? t)
|
||||
(reduced? :reduced?))
|
||||
`(progn
|
||||
(defgroup ,group nil
|
||||
,(format "Displaying '%s' entries in '%s' buffer."
|
||||
entry-type-str buffer-type-str)
|
||||
:group ',(intern (concat "guix-" entry-type-str))
|
||||
:group ',(intern (concat "guix-" buffer-type-str)))
|
||||
|
||||
(defgroup ,faces-group nil
|
||||
,(format "Faces for displaying '%s' entries in '%s' buffer."
|
||||
entry-type-str buffer-type-str)
|
||||
:group ',group
|
||||
:group ',(intern (concat "guix-" entry-type-str "-faces"))
|
||||
:group ',(intern (concat "guix-" buffer-type-str "-faces")))
|
||||
|
||||
(defcustom ,titles-var ,titles-val
|
||||
,(format "Alist of titles of '%s' parameters."
|
||||
entry-type-str)
|
||||
:type '(alist :key-type symbol :value-type string)
|
||||
:group ',group)
|
||||
|
||||
,(unless reduced?
|
||||
`(progn
|
||||
(defvar ,get-entries-var ,get-entries-val
|
||||
,(format "\
|
||||
Function used to receive '%s' entries for '%s' buffer."
|
||||
entry-type-str buffer-type-str))
|
||||
|
||||
(defvar ,show-entries-var
|
||||
,(or show-entries-val `',show-entries-fun)
|
||||
,(format "\
|
||||
Function used to show '%s' entries in '%s' buffer."
|
||||
entry-type-str buffer-type-str))
|
||||
|
||||
(defvar ,message-var ,message-val
|
||||
,(format "\
|
||||
Function used to display a message after showing '%s' entries.
|
||||
If nil, do not display messages."
|
||||
entry-type-str))
|
||||
|
||||
(defcustom ,buffer-name-var ,buffer-name-val
|
||||
,(format "\
|
||||
Default name of '%s' buffer for displaying '%s' entries.
|
||||
May be a string or a function returning a string. The function
|
||||
is called with the same arguments as `%S'."
|
||||
buffer-type-str entry-type-str get-entries-var)
|
||||
:type '(choice string function)
|
||||
:group ',group)
|
||||
|
||||
(defcustom ,history-size-var ,history-size-val
|
||||
,(format "\
|
||||
Maximum number of items saved in history of `%S' buffer.
|
||||
If 0, the history is disabled."
|
||||
buffer-name-var)
|
||||
:type 'integer
|
||||
:group ',group)
|
||||
|
||||
(defcustom ,revert-confirm-var ,revert-confirm-val
|
||||
,(format "\
|
||||
If non-nil, ask to confirm for reverting `%S' buffer."
|
||||
buffer-name-var)
|
||||
:type 'boolean
|
||||
:group ',group)
|
||||
|
||||
(guix-alist-put!
|
||||
'((get-entries . ,get-entries-var)
|
||||
(show-entries . ,show-entries-var)
|
||||
(message . ,message-var)
|
||||
(buffer-name . ,buffer-name-var)
|
||||
(history-size . ,history-size-var)
|
||||
(revert-confirm . ,revert-confirm-var))
|
||||
'guix-buffer-data ',buffer-type ',entry-type)
|
||||
|
||||
,(unless show-entries-val
|
||||
`(defun ,show-entries-fun (entries)
|
||||
,(format "\
|
||||
Show '%s' ENTRIES in the current '%s' buffer."
|
||||
entry-type-str buffer-type-str)
|
||||
(guix-buffer-show-entries-default
|
||||
entries ',buffer-type ',entry-type)))
|
||||
|
||||
,(when (or insert-entries-val
|
||||
(null show-entries-val))
|
||||
(let ((insert-entries-var
|
||||
(intern (concat prefix "-insert-function"))))
|
||||
`(progn
|
||||
(defvar ,insert-entries-var ,insert-entries-val
|
||||
,(format "\
|
||||
Function used to print '%s' entries in '%s' buffer."
|
||||
entry-type-str buffer-type-str))
|
||||
|
||||
(guix-alist-put!
|
||||
',insert-entries-var 'guix-buffer-data
|
||||
',buffer-type ',entry-type
|
||||
'insert-entries))))
|
||||
|
||||
,(when (or mode-name
|
||||
mode-init-val
|
||||
(null show-entries-val))
|
||||
(let* ((mode-str (concat prefix "-mode"))
|
||||
(mode-map-str (concat mode-str "-map"))
|
||||
(mode (intern mode-str))
|
||||
(parent-mode (intern
|
||||
(concat "guix-" buffer-type-str
|
||||
"-mode")))
|
||||
(mode-var (intern
|
||||
(concat mode-str "-function")))
|
||||
(mode-init-var (intern
|
||||
(concat mode-str
|
||||
"-initialize-function"))))
|
||||
`(progn
|
||||
(defvar ,mode-var ',mode
|
||||
,(format "\
|
||||
Major mode for displaying '%s' entries in '%s' buffer."
|
||||
entry-type-str buffer-type-str))
|
||||
|
||||
(defvar ,mode-init-var ,mode-init-val
|
||||
,(format "\
|
||||
Function used to set up '%s' buffer for displaying '%s' entries."
|
||||
buffer-type-str entry-type-str))
|
||||
|
||||
(define-derived-mode ,mode ,parent-mode ,mode-name
|
||||
,(format "\
|
||||
Major mode for displaying '%s' entries in '%s' buffer.
|
||||
|
||||
\\{%s}"
|
||||
entry-type-str buffer-type-str mode-map-str)
|
||||
(setq-local revert-buffer-function
|
||||
'guix-buffer-revert)
|
||||
(setq-local guix-history-size
|
||||
(guix-buffer-history-size
|
||||
',buffer-type ',entry-type))
|
||||
(guix-buffer-mode-initialize
|
||||
',buffer-type ',entry-type))
|
||||
|
||||
(guix-alist-put!
|
||||
',mode-var 'guix-buffer-data
|
||||
',buffer-type ',entry-type 'mode)
|
||||
(guix-alist-put!
|
||||
',mode-init-var 'guix-buffer-data
|
||||
',buffer-type ',entry-type
|
||||
'mode-init))))))
|
||||
|
||||
(guix-alist-put!
|
||||
',titles-var 'guix-buffer-data
|
||||
',buffer-type ',entry-type 'titles)))))
|
||||
|
||||
|
||||
(defvar guix-buffer-font-lock-keywords
|
||||
(eval-when-compile
|
||||
`((,(rx "(" (group (or "guix-buffer-with-item"
|
||||
"guix-buffer-with-current-item"
|
||||
"guix-buffer-define-interface"
|
||||
"guix-define-groups"
|
||||
"guix-define-entry-type"
|
||||
"guix-define-buffer-type"))
|
||||
symbol-end)
|
||||
. 1))))
|
||||
|
||||
(font-lock-add-keywords 'emacs-lisp-mode guix-buffer-font-lock-keywords)
|
||||
|
||||
(provide 'guix-buffer)
|
||||
|
||||
;;; guix-buffer.el ends here
|
||||
@@ -1,381 +0,0 @@
|
||||
;;; guix-build-log.el --- Major and minor modes for build logs -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright © 2015 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides a major mode (`guix-build-log-mode') and a minor mode
|
||||
;; (`guix-build-log-minor-mode') for highlighting Guix build logs.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'guix-utils)
|
||||
|
||||
(defgroup guix-build-log nil
|
||||
"Settings for `guix-build-log-mode'."
|
||||
:group 'guix)
|
||||
|
||||
(defgroup guix-build-log-faces nil
|
||||
"Faces for `guix-build-log-mode'."
|
||||
:group 'guix-build-log
|
||||
:group 'guix-faces)
|
||||
|
||||
(defface guix-build-log-title-head
|
||||
'((t :inherit font-lock-keyword-face))
|
||||
"Face for '@' symbol of a log title."
|
||||
:group 'guix-build-log-faces)
|
||||
|
||||
(defface guix-build-log-title-start
|
||||
'((t :inherit guix-build-log-title-head))
|
||||
"Face for a log title denoting a start of a process."
|
||||
:group 'guix-build-log-faces)
|
||||
|
||||
(defface guix-build-log-title-success
|
||||
'((t :inherit guix-build-log-title-head))
|
||||
"Face for a log title denoting a successful end of a process."
|
||||
:group 'guix-build-log-faces)
|
||||
|
||||
(defface guix-build-log-title-fail
|
||||
'((t :inherit error))
|
||||
"Face for a log title denoting a failed end of a process."
|
||||
:group 'guix-build-log-faces)
|
||||
|
||||
(defface guix-build-log-title-end
|
||||
'((t :inherit guix-build-log-title-head))
|
||||
"Face for a log title denoting an undefined end of a process."
|
||||
:group 'guix-build-log-faces)
|
||||
|
||||
(defface guix-build-log-phase-name
|
||||
'((t :inherit font-lock-function-name-face))
|
||||
"Face for a phase name."
|
||||
:group 'guix-build-log-faces)
|
||||
|
||||
(defface guix-build-log-phase-start
|
||||
'((default :weight bold)
|
||||
(((class grayscale) (background light)) :foreground "Gray90")
|
||||
(((class grayscale) (background dark)) :foreground "DimGray")
|
||||
(((class color) (min-colors 16) (background light))
|
||||
:foreground "DarkGreen")
|
||||
(((class color) (min-colors 16) (background dark))
|
||||
:foreground "LimeGreen")
|
||||
(((class color) (min-colors 8)) :foreground "green"))
|
||||
"Face for the start line of a phase."
|
||||
:group 'guix-build-log-faces)
|
||||
|
||||
(defface guix-build-log-phase-end
|
||||
'((((class grayscale) (background light)) :foreground "Gray90")
|
||||
(((class grayscale) (background dark)) :foreground "DimGray")
|
||||
(((class color) (min-colors 16) (background light))
|
||||
:foreground "ForestGreen")
|
||||
(((class color) (min-colors 16) (background dark))
|
||||
:foreground "LightGreen")
|
||||
(((class color) (min-colors 8)) :foreground "green")
|
||||
(t :weight bold))
|
||||
"Face for the end line of a phase."
|
||||
:group 'guix-build-log-faces)
|
||||
|
||||
(defface guix-build-log-phase-success
|
||||
'((t))
|
||||
"Face for the 'succeeded' word of a phase line."
|
||||
:group 'guix-build-log-faces)
|
||||
|
||||
(defface guix-build-log-phase-fail
|
||||
'((t :inherit error))
|
||||
"Face for the 'failed' word of a phase line."
|
||||
:group 'guix-build-log-faces)
|
||||
|
||||
(defface guix-build-log-phase-seconds
|
||||
'((t :inherit font-lock-constant-face))
|
||||
"Face for the number of seconds for a phase."
|
||||
:group 'guix-build-log-faces)
|
||||
|
||||
(defcustom guix-build-log-minor-mode-activate t
|
||||
"If non-nil, then `guix-build-log-minor-mode' is automatically
|
||||
activated in `shell-mode' buffers."
|
||||
:type 'boolean
|
||||
:group 'guix-build-log)
|
||||
|
||||
(defcustom guix-build-log-mode-hook '()
|
||||
"Hook run after `guix-build-log-mode' is entered."
|
||||
:type 'hook
|
||||
:group 'guix-build-log)
|
||||
|
||||
(defvar guix-build-log-phase-name-regexp "`\\([^']+\\)'"
|
||||
"Regexp for a phase name.")
|
||||
|
||||
(defvar guix-build-log-phase-start-regexp
|
||||
(concat "^starting phase " guix-build-log-phase-name-regexp)
|
||||
"Regexp for the start line of a 'build' phase.")
|
||||
|
||||
(defun guix-build-log-title-regexp (&optional state)
|
||||
"Return regexp for the log title.
|
||||
STATE is a symbol denoting a state of the title. It should be
|
||||
`start', `fail', `success' or `nil' (for a regexp matching any
|
||||
state)."
|
||||
(let* ((word-rx (rx (1+ (any word "-"))))
|
||||
(state-rx (cond ((eq state 'start) (concat word-rx "started"))
|
||||
((eq state 'success) (concat word-rx "succeeded"))
|
||||
((eq state 'fail) (concat word-rx "failed"))
|
||||
(t word-rx))))
|
||||
(rx-to-string
|
||||
`(and bol (group "@") " " (group (regexp ,state-rx)))
|
||||
t)))
|
||||
|
||||
(defun guix-build-log-phase-end-regexp (&optional state)
|
||||
"Return regexp for the end line of a 'build' phase.
|
||||
STATE is a symbol denoting how a build phase was ended. It should be
|
||||
`fail', `success' or `nil' (for a regexp matching any state)."
|
||||
(let ((state-rx (cond ((eq state 'success) "succeeded")
|
||||
((eq state 'fail) "failed")
|
||||
(t (regexp-opt '("succeeded" "failed"))))))
|
||||
(rx-to-string
|
||||
`(and bol "phase " (regexp ,guix-build-log-phase-name-regexp)
|
||||
" " (group (regexp ,state-rx)) " after "
|
||||
(group (1+ (or digit "."))) " seconds")
|
||||
t)))
|
||||
|
||||
(defvar guix-build-log-phase-end-regexp
|
||||
;; For efficiency, it is better to have a regexp for the general line
|
||||
;; of the phase end, then to call the function all the time.
|
||||
(guix-build-log-phase-end-regexp)
|
||||
"Regexp for the end line of a 'build' phase.")
|
||||
|
||||
(defvar guix-build-log-font-lock-keywords
|
||||
`((,(guix-build-log-title-regexp 'start)
|
||||
(1 'guix-build-log-title-head)
|
||||
(2 'guix-build-log-title-start))
|
||||
(,(guix-build-log-title-regexp 'success)
|
||||
(1 'guix-build-log-title-head)
|
||||
(2 'guix-build-log-title-success))
|
||||
(,(guix-build-log-title-regexp 'fail)
|
||||
(1 'guix-build-log-title-head)
|
||||
(2 'guix-build-log-title-fail))
|
||||
(,(guix-build-log-title-regexp)
|
||||
(1 'guix-build-log-title-head)
|
||||
(2 'guix-build-log-title-end))
|
||||
(,guix-build-log-phase-start-regexp
|
||||
(0 'guix-build-log-phase-start)
|
||||
(1 'guix-build-log-phase-name prepend))
|
||||
(,(guix-build-log-phase-end-regexp 'success)
|
||||
(0 'guix-build-log-phase-end)
|
||||
(1 'guix-build-log-phase-name prepend)
|
||||
(2 'guix-build-log-phase-success prepend)
|
||||
(3 'guix-build-log-phase-seconds prepend))
|
||||
(,(guix-build-log-phase-end-regexp 'fail)
|
||||
(0 'guix-build-log-phase-end)
|
||||
(1 'guix-build-log-phase-name prepend)
|
||||
(2 'guix-build-log-phase-fail prepend)
|
||||
(3 'guix-build-log-phase-seconds prepend)))
|
||||
"A list of `font-lock-keywords' for `guix-build-log-mode'.")
|
||||
|
||||
(defvar guix-build-log-common-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map (kbd "M-n") 'guix-build-log-next-phase)
|
||||
(define-key map (kbd "M-p") 'guix-build-log-previous-phase)
|
||||
(define-key map (kbd "TAB") 'guix-build-log-phase-toggle)
|
||||
(define-key map (kbd "<tab>") 'guix-build-log-phase-toggle)
|
||||
(define-key map (kbd "<backtab>") 'guix-build-log-phase-toggle-all)
|
||||
(define-key map [(shift tab)] 'guix-build-log-phase-toggle-all)
|
||||
map)
|
||||
"Parent keymap for 'build-log' buffers.
|
||||
For `guix-build-log-mode' this map is used as is.
|
||||
For `guix-build-log-minor-mode' this map is prefixed with 'C-c'.")
|
||||
|
||||
(defvar guix-build-log-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent
|
||||
map (make-composed-keymap (list guix-build-log-common-map)
|
||||
special-mode-map))
|
||||
(define-key map (kbd "c") 'compilation-shell-minor-mode)
|
||||
(define-key map (kbd "v") 'view-mode)
|
||||
map)
|
||||
"Keymap for `guix-build-log-mode' buffers.")
|
||||
|
||||
(defvar guix-build-log-minor-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map (kbd "C-c") guix-build-log-common-map)
|
||||
map)
|
||||
"Keymap for `guix-build-log-minor-mode' buffers.")
|
||||
|
||||
(defun guix-build-log-phase-start (&optional with-header?)
|
||||
"Return the start point of the current build phase.
|
||||
If WITH-HEADER? is non-nil, do not skip 'starting phase ...' header.
|
||||
Return nil, if there is no phase start before the current point."
|
||||
(save-excursion
|
||||
(end-of-line)
|
||||
(when (re-search-backward guix-build-log-phase-start-regexp nil t)
|
||||
(unless with-header? (end-of-line))
|
||||
(point))))
|
||||
|
||||
(defun guix-build-log-phase-end ()
|
||||
"Return the end point of the current build phase."
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(when (re-search-forward guix-build-log-phase-end-regexp nil t)
|
||||
(point))))
|
||||
|
||||
(defun guix-build-log-phase-hide ()
|
||||
"Hide the body of the current build phase."
|
||||
(interactive)
|
||||
(let ((beg (guix-build-log-phase-start))
|
||||
(end (guix-build-log-phase-end)))
|
||||
(when (and beg end)
|
||||
;; If not on the header line, move to it.
|
||||
(when (and (> (point) beg)
|
||||
(< (point) end))
|
||||
(goto-char (guix-build-log-phase-start t)))
|
||||
(remove-overlays beg end 'invisible t)
|
||||
(let ((o (make-overlay beg end)))
|
||||
(overlay-put o 'evaporate t)
|
||||
(overlay-put o 'invisible t)))))
|
||||
|
||||
(defun guix-build-log-phase-show ()
|
||||
"Show the body of the current build phase."
|
||||
(interactive)
|
||||
(let ((beg (guix-build-log-phase-start))
|
||||
(end (guix-build-log-phase-end)))
|
||||
(when (and beg end)
|
||||
(remove-overlays beg end 'invisible t))))
|
||||
|
||||
(defun guix-build-log-phase-hidden-p ()
|
||||
"Return non-nil, if the body of the current build phase is hidden."
|
||||
(let ((beg (guix-build-log-phase-start)))
|
||||
(and beg
|
||||
(cl-some (lambda (o)
|
||||
(overlay-get o 'invisible))
|
||||
(overlays-at beg)))))
|
||||
|
||||
(defun guix-build-log-phase-toggle-function ()
|
||||
"Return a function to toggle the body of the current build phase."
|
||||
(if (guix-build-log-phase-hidden-p)
|
||||
#'guix-build-log-phase-show
|
||||
#'guix-build-log-phase-hide))
|
||||
|
||||
(defun guix-build-log-phase-toggle ()
|
||||
"Show/hide the body of the current build phase."
|
||||
(interactive)
|
||||
(funcall (guix-build-log-phase-toggle-function)))
|
||||
|
||||
(defun guix-build-log-phase-toggle-all ()
|
||||
"Show/hide the bodies of all build phases."
|
||||
(interactive)
|
||||
(save-excursion
|
||||
;; Some phases may be hidden, and some shown. Whether to hide or to
|
||||
;; show them, it is determined by the state of the first phase here.
|
||||
(goto-char (point-min))
|
||||
(let ((fun (save-excursion
|
||||
(re-search-forward guix-build-log-phase-start-regexp nil t)
|
||||
(guix-build-log-phase-toggle-function))))
|
||||
(while (re-search-forward guix-build-log-phase-start-regexp nil t)
|
||||
(funcall fun)))))
|
||||
|
||||
(defun guix-build-log-next-phase (&optional arg)
|
||||
"Move to the next build phase.
|
||||
With ARG, do it that many times. Negative ARG means move
|
||||
backward."
|
||||
(interactive "^p")
|
||||
(if arg
|
||||
(when (zerop arg) (user-error "Try again"))
|
||||
(setq arg 1))
|
||||
(let ((search-fun (if (> arg 0)
|
||||
#'re-search-forward
|
||||
#'re-search-backward))
|
||||
(n (abs arg))
|
||||
found last-found)
|
||||
(save-excursion
|
||||
(end-of-line (if (> arg 0) 1 0)) ; skip the current line
|
||||
(while (and (not (zerop n))
|
||||
(setq found
|
||||
(funcall search-fun
|
||||
guix-build-log-phase-start-regexp
|
||||
nil t)))
|
||||
(setq n (1- n)
|
||||
last-found found)))
|
||||
(when last-found
|
||||
(goto-char last-found)
|
||||
(forward-line 0))
|
||||
(or found
|
||||
(user-error (if (> arg 0)
|
||||
"No next build phase"
|
||||
"No previous build phase")))))
|
||||
|
||||
(defun guix-build-log-previous-phase (&optional arg)
|
||||
"Move to the previous build phase.
|
||||
With ARG, do it that many times. Negative ARG means move
|
||||
forward."
|
||||
(interactive "^p")
|
||||
(guix-build-log-next-phase (- (or arg 1))))
|
||||
|
||||
;;;###autoload
|
||||
(define-derived-mode guix-build-log-mode special-mode
|
||||
"Guix-Build-Log"
|
||||
"Major mode for viewing Guix build logs.
|
||||
|
||||
\\{guix-build-log-mode-map}"
|
||||
(setq font-lock-defaults '(guix-build-log-font-lock-keywords t)))
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode guix-build-log-minor-mode
|
||||
"Toggle Guix Build Log minor mode.
|
||||
|
||||
With a prefix argument ARG, enable Guix Build Log minor mode if
|
||||
ARG is positive, and disable it otherwise. If called from Lisp,
|
||||
enable the mode if ARG is omitted or nil.
|
||||
|
||||
When Guix Build Log minor mode is enabled, it highlights build
|
||||
log in the current buffer. This mode can be enabled
|
||||
programmatically using hooks:
|
||||
|
||||
(add-hook 'shell-mode-hook 'guix-build-log-minor-mode)
|
||||
|
||||
\\{guix-build-log-minor-mode-map}"
|
||||
:init-value nil
|
||||
:lighter " Guix-Build-Log"
|
||||
:keymap guix-build-log-minor-mode-map
|
||||
:group 'guix-build-log
|
||||
(if guix-build-log-minor-mode
|
||||
(font-lock-add-keywords nil guix-build-log-font-lock-keywords)
|
||||
(font-lock-remove-keywords nil guix-build-log-font-lock-keywords))
|
||||
(when font-lock-mode
|
||||
(font-lock-fontify-buffer)))
|
||||
|
||||
;;;###autoload
|
||||
(defun guix-build-log-minor-mode-activate-maybe ()
|
||||
"Activate `guix-build-log-minor-mode' depending on
|
||||
`guix-build-log-minor-mode-activate' variable."
|
||||
(when guix-build-log-minor-mode-activate
|
||||
(guix-build-log-minor-mode)))
|
||||
|
||||
(defun guix-build-log-find-file (file-or-url)
|
||||
"Open FILE-OR-URL in `guix-build-log-mode'."
|
||||
(guix-find-file-or-url file-or-url)
|
||||
(guix-build-log-mode))
|
||||
|
||||
;;;###autoload
|
||||
(add-hook 'shell-mode-hook 'guix-build-log-minor-mode-activate-maybe)
|
||||
|
||||
;;;###autoload
|
||||
(add-to-list 'auto-mode-alist
|
||||
;; Regexp for log files (usually placed in /var/log/guix/...)
|
||||
(cons (rx "/guix/drvs/" (= 2 alnum) "/" (= 30 alnum)
|
||||
"-" (+ (any alnum "-+.")) ".drv" string-end)
|
||||
'guix-build-log-mode))
|
||||
|
||||
(provide 'guix-build-log)
|
||||
|
||||
;;; guix-build-log.el ends here
|
||||
@@ -1,830 +0,0 @@
|
||||
;;; guix-command.el --- Popup interface for guix commands -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides a magit-like popup interface for running guix
|
||||
;; commands in Guix REPL. The entry point is "M-x guix". When it is
|
||||
;; called the first time, "guix --help" output is parsed and
|
||||
;; `guix-COMMAND-action' functions are generated for each available guix
|
||||
;; COMMAND. Then a window with these commands is popped up. When a
|
||||
;; particular COMMAND is called, "guix COMMAND --help" output is parsed,
|
||||
;; and a user get a new popup window with available options for this
|
||||
;; command and so on.
|
||||
|
||||
;; To avoid hard-coding all guix options, actions, etc., as much data is
|
||||
;; taken from "guix ... --help" outputs as possible. But this data is
|
||||
;; still incomplete: not all long options have short analogs, also
|
||||
;; special readers should be used for some options (for example, to
|
||||
;; complete package names while prompting for a package). So after
|
||||
;; parsing --help output, the arguments are "improved". All arguments
|
||||
;; (switches, options and actions) are `guix-command-argument'
|
||||
;; structures.
|
||||
|
||||
;; Only "M-x guix" command is available after this file is loaded. The
|
||||
;; rest commands/actions/popups are generated on the fly only when they
|
||||
;; are needed (that's why there is a couple of `eval'-s in this file).
|
||||
|
||||
;; COMMANDS argument is used by many functions in this file. It means a
|
||||
;; list of guix commands without "guix" itself, e.g.: ("build"),
|
||||
;; ("import" "gnu"). The empty list stands for the plain "guix" without
|
||||
;; subcommands.
|
||||
|
||||
;; All actions in popup windows are divided into 2 groups:
|
||||
;;
|
||||
;; - 'Popup' actions - used to pop up another window. For example, every
|
||||
;; action in the 'guix' or 'guix import' window is a popup action. They
|
||||
;; are defined by `guix-command-define-popup-action' macro.
|
||||
;;
|
||||
;; - 'Execute' actions - used to do something with the command line (to
|
||||
;; run a command in Guix REPL or to copy it into kill-ring) constructed
|
||||
;; with the current popup. They are defined by
|
||||
;; `guix-command-define-execute-action' macro.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'guix-popup)
|
||||
(require 'guix-utils)
|
||||
(require 'guix-help-vars)
|
||||
(require 'guix-read)
|
||||
(require 'guix-base)
|
||||
(require 'guix-build-log)
|
||||
(require 'guix-guile)
|
||||
(require 'guix-external)
|
||||
|
||||
(defgroup guix-commands nil
|
||||
"Settings for guix popup windows."
|
||||
:group 'guix)
|
||||
|
||||
(defvar guix-command-complex-with-shared-arguments
|
||||
'("system")
|
||||
"List of guix commands which have subcommands with shared options.
|
||||
I.e., 'guix foo --help' is the same as 'guix foo bar --help'.")
|
||||
|
||||
(defun guix-command-action-name (&optional commands &rest name-parts)
|
||||
"Return name of action function for guix COMMANDS."
|
||||
(guix-command-symbol (append commands name-parts (list "action"))))
|
||||
|
||||
|
||||
;;; Command arguments
|
||||
|
||||
(cl-defstruct (guix-command-argument
|
||||
(:constructor guix-command-make-argument)
|
||||
(:copier guix-command-copy-argument))
|
||||
name char doc fun switch? option? action?)
|
||||
|
||||
(cl-defun guix-command-modify-argument
|
||||
(argument &key
|
||||
(name nil name-bound?)
|
||||
(char nil char-bound?)
|
||||
(doc nil doc-bound?)
|
||||
(fun nil fun-bound?)
|
||||
(switch? nil switch?-bound?)
|
||||
(option? nil option?-bound?)
|
||||
(action? nil action?-bound?))
|
||||
"Return a modified version of ARGUMENT."
|
||||
(declare (indent 1))
|
||||
(let ((copy (guix-command-copy-argument argument)))
|
||||
(and name-bound? (setf (guix-command-argument-name copy) name))
|
||||
(and char-bound? (setf (guix-command-argument-char copy) char))
|
||||
(and doc-bound? (setf (guix-command-argument-doc copy) doc))
|
||||
(and fun-bound? (setf (guix-command-argument-fun copy) fun))
|
||||
(and switch?-bound? (setf (guix-command-argument-switch? copy) switch?))
|
||||
(and option?-bound? (setf (guix-command-argument-option? copy) option?))
|
||||
(and action?-bound? (setf (guix-command-argument-action? copy) action?))
|
||||
copy))
|
||||
|
||||
(defun guix-command-modify-argument-from-alist (argument alist)
|
||||
"Return a modified version of ARGUMENT or nil if it wasn't modified.
|
||||
Each assoc from ALIST have a form (NAME . PLIST). NAME is an
|
||||
argument name. PLIST is a property list of argument parameters
|
||||
to be modified."
|
||||
(let* ((name (guix-command-argument-name argument))
|
||||
(plist (guix-assoc-value alist name)))
|
||||
(when plist
|
||||
(apply #'guix-command-modify-argument
|
||||
argument plist))))
|
||||
|
||||
(defmacro guix-command-define-argument-improver (name alist)
|
||||
"Define NAME variable and function to modify an argument from ALIST."
|
||||
(declare (indent 1))
|
||||
`(progn
|
||||
(defvar ,name ,alist)
|
||||
(defun ,name (argument)
|
||||
(guix-command-modify-argument-from-alist argument ,name))))
|
||||
|
||||
(guix-command-define-argument-improver
|
||||
guix-command-improve-action-argument
|
||||
'(("container" :char ?C)
|
||||
("graph" :char ?G)
|
||||
("environment" :char ?E)
|
||||
("publish" :char ?u)
|
||||
("pull" :char ?P)
|
||||
("size" :char ?z)))
|
||||
|
||||
(guix-command-define-argument-improver
|
||||
guix-command-improve-common-argument
|
||||
'(("--help" :switch? nil)
|
||||
("--version" :switch? nil)))
|
||||
|
||||
(guix-command-define-argument-improver
|
||||
guix-command-improve-target-argument
|
||||
'(("--target" :char ?T)))
|
||||
|
||||
(guix-command-define-argument-improver
|
||||
guix-command-improve-system-type-argument
|
||||
'(("--system" :fun guix-read-system-type)))
|
||||
|
||||
(guix-command-define-argument-improver
|
||||
guix-command-improve-load-path-argument
|
||||
'(("--load-path" :fun read-directory-name)))
|
||||
|
||||
(guix-command-define-argument-improver
|
||||
guix-command-improve-search-paths-argument
|
||||
'(("--search-paths" :char ?P)))
|
||||
|
||||
(guix-command-define-argument-improver
|
||||
guix-command-improve-substitute-urls-argument
|
||||
'(("--substitute-urls" :char ?U)))
|
||||
|
||||
(guix-command-define-argument-improver
|
||||
guix-command-improve-hash-argument
|
||||
'(("--format" :fun guix-read-hash-format)))
|
||||
|
||||
(guix-command-define-argument-improver
|
||||
guix-command-improve-key-policy-argument
|
||||
'(("--key-download" :fun guix-read-key-policy)))
|
||||
|
||||
(defvar guix-command-improve-common-build-argument
|
||||
'(("--no-substitutes" :char ?s)
|
||||
("--no-build-hook" :char ?h)
|
||||
("--max-silent-time" :char ?x)
|
||||
("--rounds" :char ?R :fun read-number)
|
||||
("--with-input" :char ?W)))
|
||||
|
||||
(defun guix-command-improve-common-build-argument (argument)
|
||||
(guix-command-modify-argument-from-alist
|
||||
argument
|
||||
(append guix-command-improve-load-path-argument
|
||||
guix-command-improve-substitute-urls-argument
|
||||
guix-command-improve-common-build-argument)))
|
||||
|
||||
(guix-command-define-argument-improver
|
||||
guix-command-improve-archive-argument
|
||||
'(("--generate-key" :char ?k)))
|
||||
|
||||
(guix-command-define-argument-improver
|
||||
guix-command-improve-build-argument
|
||||
'(("--no-grafts" :char ?g)
|
||||
("--file" :fun guix-read-file-name)
|
||||
("--root" :fun guix-read-file-name)
|
||||
("--sources" :char ?S :fun guix-read-source-type :switch? nil)
|
||||
("--with-source" :fun guix-read-file-name)))
|
||||
|
||||
(guix-command-define-argument-improver
|
||||
guix-command-improve-environment-argument
|
||||
'(("--ad-hoc"
|
||||
:name "--ad-hoc " :fun guix-read-package-names-string
|
||||
:switch? nil :option? t)
|
||||
("--expose" :char ?E)
|
||||
("--share" :char ?S)
|
||||
("--load" :fun guix-read-file-name)))
|
||||
|
||||
(guix-command-define-argument-improver
|
||||
guix-command-improve-gc-argument
|
||||
'(("--list-dead" :char ?D)
|
||||
("--list-live" :char ?L)
|
||||
("--referrers" :char ?f)
|
||||
("--verify" :fun guix-read-verify-options-string)))
|
||||
|
||||
(guix-command-define-argument-improver
|
||||
guix-command-improve-graph-argument
|
||||
'(("--type" :fun guix-read-graph-type)))
|
||||
|
||||
(guix-command-define-argument-improver
|
||||
guix-command-improve-import-argument
|
||||
'(("cran" :char ?r)))
|
||||
|
||||
(guix-command-define-argument-improver
|
||||
guix-command-improve-import-elpa-argument
|
||||
'(("--archive" :fun guix-read-elpa-archive)))
|
||||
|
||||
(guix-command-define-argument-improver
|
||||
guix-command-improve-lint-argument
|
||||
'(("--checkers" :fun guix-read-lint-checker-names-string)))
|
||||
|
||||
(guix-command-define-argument-improver
|
||||
guix-command-improve-package-argument
|
||||
;; Unlike all other options, --install/--remove do not have a form
|
||||
;; '--install=foo,bar' but '--install foo bar' instead, so we need
|
||||
;; some tweaks.
|
||||
'(("--install"
|
||||
:name "--install " :fun guix-read-package-names-string
|
||||
:switch? nil :option? t)
|
||||
("--remove"
|
||||
:name "--remove " :fun guix-read-package-names-string
|
||||
:switch? nil :option? t)
|
||||
("--install-from-file" :fun guix-read-file-name)
|
||||
("--manifest" :fun guix-read-file-name)
|
||||
("--profile" :fun guix-read-file-name)
|
||||
("--do-not-upgrade" :char ?U)
|
||||
("--roll-back" :char ?R)
|
||||
("--show" :char ?w :fun guix-read-package-name)))
|
||||
|
||||
(guix-command-define-argument-improver
|
||||
guix-command-improve-refresh-argument
|
||||
'(("--select" :fun guix-read-refresh-subset)
|
||||
("--type" :fun guix-read-refresh-updater-names-string)
|
||||
("--key-server" :char ?S)))
|
||||
|
||||
(guix-command-define-argument-improver
|
||||
guix-command-improve-size-argument
|
||||
'(("--map-file" :fun guix-read-file-name)))
|
||||
|
||||
(guix-command-define-argument-improver
|
||||
guix-command-improve-system-argument
|
||||
'(("disk-image" :char ?D)
|
||||
("vm-image" :char ?V)
|
||||
("--on-error" :char ?E)
|
||||
("--no-grub" :char ?g)
|
||||
("--full-boot" :char ?b)))
|
||||
|
||||
(defvar guix-command-argument-improvers
|
||||
'((()
|
||||
guix-command-improve-action-argument)
|
||||
(("archive")
|
||||
guix-command-improve-common-build-argument
|
||||
guix-command-improve-target-argument
|
||||
guix-command-improve-system-type-argument
|
||||
guix-command-improve-archive-argument)
|
||||
(("build")
|
||||
guix-command-improve-common-build-argument
|
||||
guix-command-improve-target-argument
|
||||
guix-command-improve-system-type-argument
|
||||
guix-command-improve-build-argument)
|
||||
(("download")
|
||||
guix-command-improve-hash-argument)
|
||||
(("hash")
|
||||
guix-command-improve-hash-argument)
|
||||
(("environment")
|
||||
guix-command-improve-common-build-argument
|
||||
guix-command-improve-search-paths-argument
|
||||
guix-command-improve-system-type-argument
|
||||
guix-command-improve-environment-argument)
|
||||
(("gc")
|
||||
guix-command-improve-gc-argument)
|
||||
(("graph")
|
||||
guix-command-improve-graph-argument)
|
||||
(("import")
|
||||
guix-command-improve-import-argument)
|
||||
(("import" "gnu")
|
||||
guix-command-improve-key-policy-argument)
|
||||
(("import" "elpa")
|
||||
guix-command-improve-import-elpa-argument)
|
||||
(("lint")
|
||||
guix-command-improve-lint-argument)
|
||||
(("package")
|
||||
guix-command-improve-common-build-argument
|
||||
guix-command-improve-search-paths-argument
|
||||
guix-command-improve-package-argument)
|
||||
(("refresh")
|
||||
guix-command-improve-key-policy-argument
|
||||
guix-command-improve-refresh-argument)
|
||||
(("size")
|
||||
guix-command-improve-system-type-argument
|
||||
guix-command-improve-substitute-urls-argument
|
||||
guix-command-improve-size-argument)
|
||||
(("system")
|
||||
guix-command-improve-common-build-argument
|
||||
guix-command-improve-system-argument))
|
||||
"Alist of guix commands and argument improvers for them.")
|
||||
|
||||
(defun guix-command-improve-argument (argument improvers)
|
||||
"Return ARGUMENT modified with IMPROVERS."
|
||||
(or (cl-some (lambda (improver)
|
||||
(funcall improver argument))
|
||||
improvers)
|
||||
argument))
|
||||
|
||||
(defun guix-command-improve-arguments (arguments commands)
|
||||
"Return ARGUMENTS for 'guix COMMANDS ...' modified for popup interface."
|
||||
(let ((improvers (cons 'guix-command-improve-common-argument
|
||||
(guix-assoc-value guix-command-argument-improvers
|
||||
commands))))
|
||||
(mapcar (lambda (argument)
|
||||
(guix-command-improve-argument argument improvers))
|
||||
arguments)))
|
||||
|
||||
(defun guix-command-parse-arguments (&optional commands)
|
||||
"Return a list of parsed 'guix COMMANDS ...' arguments."
|
||||
(with-temp-buffer
|
||||
(insert (guix-help-string commands))
|
||||
(let (args)
|
||||
(guix-while-search guix-help-parse-option-regexp
|
||||
(let* ((short (match-string-no-properties 1))
|
||||
(name (match-string-no-properties 2))
|
||||
(arg (match-string-no-properties 3))
|
||||
(doc (match-string-no-properties 4))
|
||||
(char (if short
|
||||
(elt short 1) ; short option letter
|
||||
(elt name 2))) ; first letter of the long option
|
||||
;; If "--foo=bar" or "--foo[=bar]" then it is 'option'.
|
||||
(option? (not (string= "" arg)))
|
||||
;; If "--foo" or "--foo[=bar]" then it is 'switch'.
|
||||
(switch? (or (string= "" arg)
|
||||
(eq ?\[ (elt arg 0)))))
|
||||
(push (guix-command-make-argument
|
||||
:name name
|
||||
:char char
|
||||
:doc doc
|
||||
:switch? switch?
|
||||
:option? option?)
|
||||
args)))
|
||||
(guix-while-search guix-help-parse-command-regexp
|
||||
(let* ((name (match-string-no-properties 1))
|
||||
(char (elt name 0)))
|
||||
(push (guix-command-make-argument
|
||||
:name name
|
||||
:char char
|
||||
:fun (guix-command-action-name commands name)
|
||||
:action? t)
|
||||
args)))
|
||||
args)))
|
||||
|
||||
(defun guix-command-rest-argument (&optional commands)
|
||||
"Return '--' argument for COMMANDS."
|
||||
(cl-flet ((argument (&rest args)
|
||||
(apply #'guix-command-make-argument
|
||||
:name "-- " :char ?= :option? t args)))
|
||||
(let ((command (car commands)))
|
||||
(cond
|
||||
((member command
|
||||
'("archive" "build" "challenge" "edit"
|
||||
"graph" "lint" "refresh"))
|
||||
(argument :doc "Packages" :fun 'guix-read-package-names-string))
|
||||
((equal commands '("container" "exec"))
|
||||
(argument :doc "PID Command [Args...]"))
|
||||
((string= command "download")
|
||||
(argument :doc "URL"))
|
||||
((string= command "environment")
|
||||
(argument :doc "Command [Args...]" :fun 'read-shell-command))
|
||||
((string= command "gc")
|
||||
(argument :doc "Paths" :fun 'guix-read-file-name))
|
||||
((member command '("hash" "system"))
|
||||
(argument :doc "File" :fun 'guix-read-file-name))
|
||||
((string= command "size")
|
||||
(argument :doc "Package" :fun 'guix-read-package-name))
|
||||
((equal commands '("import" "nix"))
|
||||
(argument :doc "Nixpkgs Attribute"))
|
||||
;; Other 'guix import' subcommands, but not 'import' itself.
|
||||
((and (cdr commands)
|
||||
(string= command "import"))
|
||||
(argument :doc "Package name"))))))
|
||||
|
||||
(defvar guix-command-additional-arguments
|
||||
`((("environment")
|
||||
,(guix-command-make-argument
|
||||
:name "++packages " :char ?p :option? t
|
||||
:doc "build inputs of the specified packages"
|
||||
:fun 'guix-read-package-names-string)))
|
||||
"Alist of guix commands and additional arguments for them.
|
||||
These are 'fake' arguments that are not presented in 'guix' shell
|
||||
commands.")
|
||||
|
||||
(defun guix-command-additional-arguments (&optional commands)
|
||||
"Return additional arguments for COMMANDS."
|
||||
(let ((rest-arg (guix-command-rest-argument commands)))
|
||||
(append (guix-assoc-value guix-command-additional-arguments
|
||||
commands)
|
||||
(and rest-arg (list rest-arg)))))
|
||||
|
||||
;; Ideally only `guix-command-arguments' function should exist with the
|
||||
;; contents of `guix-command-all-arguments', but we need to make a
|
||||
;; special case for `guix-command-complex-with-shared-arguments' commands.
|
||||
|
||||
(defun guix-command-all-arguments (&optional commands)
|
||||
"Return list of all arguments for 'guix COMMANDS ...'."
|
||||
(let ((parsed (guix-command-parse-arguments commands)))
|
||||
(append (guix-command-improve-arguments parsed commands)
|
||||
(guix-command-additional-arguments commands))))
|
||||
|
||||
(guix-memoized-defalias guix-command-all-arguments-memoize
|
||||
guix-command-all-arguments)
|
||||
|
||||
(defun guix-command-arguments (&optional commands)
|
||||
"Return list of arguments for 'guix COMMANDS ...'."
|
||||
(let ((command (car commands)))
|
||||
(if (member command
|
||||
guix-command-complex-with-shared-arguments)
|
||||
;; Take actions only for 'guix system', and switches+options for
|
||||
;; 'guix system foo'.
|
||||
(funcall (if (null (cdr commands))
|
||||
#'cl-remove-if-not
|
||||
#'cl-remove-if)
|
||||
#'guix-command-argument-action?
|
||||
(guix-command-all-arguments-memoize (list command)))
|
||||
(guix-command-all-arguments commands))))
|
||||
|
||||
(defun guix-command-switch->popup-switch (switch)
|
||||
"Return popup switch from command SWITCH argument."
|
||||
(list (guix-command-argument-char switch)
|
||||
(or (guix-command-argument-doc switch)
|
||||
"Unknown")
|
||||
(guix-command-argument-name switch)))
|
||||
|
||||
(defun guix-command-option->popup-option (option)
|
||||
"Return popup option from command OPTION argument."
|
||||
(list (guix-command-argument-char option)
|
||||
(or (guix-command-argument-doc option)
|
||||
"Unknown")
|
||||
(let ((name (guix-command-argument-name option)))
|
||||
(if (string-match-p " \\'" name) ; ends with space
|
||||
name
|
||||
(concat name "=")))
|
||||
(or (guix-command-argument-fun option)
|
||||
'read-from-minibuffer)))
|
||||
|
||||
(defun guix-command-action->popup-action (action)
|
||||
"Return popup action from command ACTION argument."
|
||||
(list (guix-command-argument-char action)
|
||||
(or (guix-command-argument-doc action)
|
||||
(guix-command-argument-name action)
|
||||
"Unknown")
|
||||
(guix-command-argument-fun action)))
|
||||
|
||||
(defun guix-command-sort-arguments (arguments)
|
||||
"Sort ARGUMENTS by name in alphabetical order."
|
||||
(sort arguments
|
||||
(lambda (a1 a2)
|
||||
(let ((name1 (guix-command-argument-name a1))
|
||||
(name2 (guix-command-argument-name a2)))
|
||||
(cond ((null name1) nil)
|
||||
((null name2) t)
|
||||
(t (string< name1 name2)))))))
|
||||
|
||||
(defun guix-command-switches (arguments)
|
||||
"Return switches from ARGUMENTS."
|
||||
(cl-remove-if-not #'guix-command-argument-switch? arguments))
|
||||
|
||||
(defun guix-command-options (arguments)
|
||||
"Return options from ARGUMENTS."
|
||||
(cl-remove-if-not #'guix-command-argument-option? arguments))
|
||||
|
||||
(defun guix-command-actions (arguments)
|
||||
"Return actions from ARGUMENTS."
|
||||
(cl-remove-if-not #'guix-command-argument-action? arguments))
|
||||
|
||||
|
||||
;;; Post processing popup arguments
|
||||
|
||||
(defvar guix-command-post-processors
|
||||
'(("environment"
|
||||
guix-command-post-process-environment-packages
|
||||
guix-command-post-process-environment-ad-hoc
|
||||
guix-command-post-process-rest-multiple-leave)
|
||||
("hash"
|
||||
guix-command-post-process-rest-single)
|
||||
("package"
|
||||
guix-command-post-process-package-args)
|
||||
("system"
|
||||
guix-command-post-process-rest-single))
|
||||
"Alist of guix commands and functions for post-processing
|
||||
a list of arguments returned from popup interface.
|
||||
Each function is called on the returned arguments in turn.")
|
||||
|
||||
(defvar guix-command-rest-arg-regexp
|
||||
(rx string-start "-- " (group (+ any)))
|
||||
"Regexp to match a string with the 'rest' arguments.")
|
||||
|
||||
(defun guix-command-replace-args (args predicate modifier)
|
||||
"Replace arguments matching PREDICATE from ARGS.
|
||||
Call MODIFIER on each argument matching PREDICATE and append the
|
||||
returned list of strings to the end of ARGS. Remove the original
|
||||
arguments."
|
||||
(let* ((rest nil)
|
||||
(args (mapcar (lambda (arg)
|
||||
(if (funcall predicate arg)
|
||||
(progn
|
||||
(push (funcall modifier arg) rest)
|
||||
nil)
|
||||
arg))
|
||||
args)))
|
||||
(if rest
|
||||
(apply #'append (delq nil args) rest)
|
||||
args)))
|
||||
|
||||
(cl-defun guix-command-post-process-matching-args (args regexp
|
||||
&key group split?)
|
||||
"Modify arguments from ARGS matching REGEXP by moving them to
|
||||
the end of ARGS list. If SPLIT? is non-nil, split matching
|
||||
arguments into multiple subarguments."
|
||||
(guix-command-replace-args
|
||||
args
|
||||
(lambda (arg)
|
||||
(string-match regexp arg))
|
||||
(lambda (arg)
|
||||
(let ((val (match-string (or group 0) arg))
|
||||
(fun (if split? #'split-string #'list)))
|
||||
(funcall fun val)))))
|
||||
|
||||
(defun guix-command-post-process-rest-single (args)
|
||||
"Modify ARGS by moving '-- ARG' argument to the end of ARGS list."
|
||||
(guix-command-post-process-matching-args
|
||||
args guix-command-rest-arg-regexp
|
||||
:group 1))
|
||||
|
||||
(defun guix-command-post-process-rest-multiple (args)
|
||||
"Modify ARGS by splitting '-- ARG ...' into multiple subarguments
|
||||
and moving them to the end of ARGS list.
|
||||
Remove '-- ' string."
|
||||
(guix-command-post-process-matching-args
|
||||
args guix-command-rest-arg-regexp
|
||||
:group 1
|
||||
:split? t))
|
||||
|
||||
(defun guix-command-post-process-rest-multiple-leave (args)
|
||||
"Modify ARGS by splitting '-- ARG ...' into multiple subarguments
|
||||
and moving them to the end of ARGS list.
|
||||
Leave '--' string as a separate argument."
|
||||
(guix-command-post-process-matching-args
|
||||
args guix-command-rest-arg-regexp
|
||||
:split? t))
|
||||
|
||||
(defun guix-command-post-process-package-args (args)
|
||||
"Adjust popup ARGS for 'guix package' command."
|
||||
(guix-command-post-process-matching-args
|
||||
args (rx string-start (or "--install " "--remove ") (+ any))
|
||||
:split? t))
|
||||
|
||||
(defun guix-command-post-process-environment-packages (args)
|
||||
"Adjust popup ARGS for specified packages of 'guix environment'
|
||||
command."
|
||||
(guix-command-post-process-matching-args
|
||||
args (rx string-start "++packages " (group (+ any)))
|
||||
:group 1
|
||||
:split? t))
|
||||
|
||||
(defun guix-command-post-process-environment-ad-hoc (args)
|
||||
"Adjust popup ARGS for '--ad-hoc' argument of 'guix environment'
|
||||
command."
|
||||
(guix-command-post-process-matching-args
|
||||
args (rx string-start "--ad-hoc " (+ any))
|
||||
:split? t))
|
||||
|
||||
(defun guix-command-post-process-args (commands args)
|
||||
"Adjust popup ARGS for guix COMMANDS."
|
||||
(let* ((command (car commands))
|
||||
(processors
|
||||
(append (guix-assoc-value guix-command-post-processors commands)
|
||||
(guix-assoc-value guix-command-post-processors command))))
|
||||
(guix-modify args
|
||||
(or processors
|
||||
(list #'guix-command-post-process-rest-multiple)))))
|
||||
|
||||
|
||||
;;; 'Execute' actions
|
||||
|
||||
(defvar guix-command-default-execute-arguments
|
||||
(list
|
||||
(guix-command-make-argument
|
||||
:name "repl" :char ?r :doc "Run in Guix REPL")
|
||||
(guix-command-make-argument
|
||||
:name "shell" :char ?s :doc "Run in shell")
|
||||
(guix-command-make-argument
|
||||
:name "copy" :char ?c :doc "Copy command line"))
|
||||
"List of default 'execute' action arguments.")
|
||||
|
||||
(defvar guix-command-additional-execute-arguments
|
||||
(let ((graph-arg (guix-command-make-argument
|
||||
:name "view" :char ?v :doc "View graph")))
|
||||
`((("build")
|
||||
,(guix-command-make-argument
|
||||
:name "log" :char ?l :doc "View build log"))
|
||||
(("graph") ,graph-arg)
|
||||
(("size")
|
||||
,(guix-command-make-argument
|
||||
:name "view" :char ?v :doc "View map"))
|
||||
(("system" "shepherd-graph") ,graph-arg)
|
||||
(("system" "extension-graph") ,graph-arg)))
|
||||
"Alist of guix commands and additional 'execute' action arguments.")
|
||||
|
||||
(defun guix-command-execute-arguments (commands)
|
||||
"Return a list of 'execute' action arguments for COMMANDS."
|
||||
(mapcar (lambda (arg)
|
||||
(guix-command-modify-argument arg
|
||||
:action? t
|
||||
:fun (guix-command-action-name
|
||||
commands (guix-command-argument-name arg))))
|
||||
(append guix-command-default-execute-arguments
|
||||
(guix-assoc-value
|
||||
guix-command-additional-execute-arguments commands))))
|
||||
|
||||
(defvar guix-command-special-executors
|
||||
'((("environment")
|
||||
("repl" . guix-run-environment-command-in-repl))
|
||||
(("pull")
|
||||
("repl" . guix-run-pull-command-in-repl))
|
||||
(("build")
|
||||
("log" . guix-run-view-build-log))
|
||||
(("graph")
|
||||
("view" . guix-run-view-graph))
|
||||
(("size")
|
||||
("view" . guix-run-view-size-map))
|
||||
(("system" "shepherd-graph")
|
||||
("view" . guix-run-view-graph))
|
||||
(("system" "extension-graph")
|
||||
("view" . guix-run-view-graph)))
|
||||
"Alist of guix commands and alists of special executers for them.
|
||||
See also `guix-command-default-executors'.")
|
||||
|
||||
(defvar guix-command-default-executors
|
||||
'(("repl" . guix-run-command-in-repl)
|
||||
("shell" . guix-run-command-in-shell)
|
||||
("copy" . guix-copy-command-as-kill))
|
||||
"Alist of default executers for action names.")
|
||||
|
||||
(defun guix-command-executor (commands name)
|
||||
"Return function to run command line arguments for guix COMMANDS."
|
||||
(or (guix-assoc-value guix-command-special-executors commands name)
|
||||
(guix-assoc-value guix-command-default-executors name)))
|
||||
|
||||
(defun guix-run-environment-command-in-repl (args)
|
||||
"Run 'guix ARGS ...' environment command in Guix REPL."
|
||||
;; As 'guix environment' usually tries to run another process, it may
|
||||
;; be fun but not wise to run this command in Geiser REPL.
|
||||
(when (or (member "--dry-run" args)
|
||||
(member "--search-paths" args)
|
||||
(when (y-or-n-p
|
||||
(format "'%s' command will spawn an external process.
|
||||
Do you really want to execute this command in Geiser REPL? "
|
||||
(guix-command-string args)))
|
||||
(message "May \"M-x shell-mode\" be with you!")
|
||||
t))
|
||||
(guix-run-command-in-repl args)))
|
||||
|
||||
(defun guix-run-pull-command-in-repl (args)
|
||||
"Run 'guix ARGS ...' pull command in Guix REPL.
|
||||
Perform pull-specific actions after operation, see
|
||||
`guix-after-pull-hook' and `guix-update-after-pull'."
|
||||
(guix-eval-in-repl
|
||||
(apply #'guix-make-guile-expression 'guix-command args)
|
||||
nil 'pull))
|
||||
|
||||
(defun guix-run-view-build-log (args)
|
||||
"Add --log-file to ARGS, run 'guix ARGS ...' build command, and
|
||||
open the log file(s)."
|
||||
(let* ((args (if (member "--log-file" args)
|
||||
args
|
||||
(cl-list* (car args) "--log-file" (cdr args))))
|
||||
(output (guix-command-output args))
|
||||
(files (split-string output "\n" t)))
|
||||
(dolist (file files)
|
||||
(guix-build-log-find-file file))))
|
||||
|
||||
(defun guix-run-view-graph (args)
|
||||
"Run 'guix ARGS ...' graph command, make the image and open it."
|
||||
(let* ((graph-file (guix-dot-file-name))
|
||||
(dot-args (guix-dot-arguments graph-file)))
|
||||
(if (guix-eval-read (guix-make-guile-expression
|
||||
'pipe-guix-output args dot-args))
|
||||
(guix-find-file graph-file)
|
||||
(error "Couldn't create a graph"))))
|
||||
|
||||
(defun guix-run-view-size-map (args)
|
||||
"Run 'guix ARGS ...' size command, and open the map file."
|
||||
(let* ((wished-map-file
|
||||
(cl-some (lambda (arg)
|
||||
(and (string-match "--map-file=\\(.+\\)" arg)
|
||||
(match-string 1 arg)))
|
||||
args))
|
||||
(map-file (or wished-map-file (guix-png-file-name)))
|
||||
(args (if wished-map-file
|
||||
args
|
||||
(cl-list* (car args)
|
||||
(concat "--map-file=" map-file)
|
||||
(cdr args)))))
|
||||
(guix-command-output args)
|
||||
(guix-find-file map-file)))
|
||||
|
||||
|
||||
;;; Generating popups, actions, etc.
|
||||
|
||||
(defmacro guix-command-define-popup-action (name &optional commands)
|
||||
"Define NAME function to generate (if needed) and run popup for COMMANDS."
|
||||
(declare (indent 1) (debug t))
|
||||
(let* ((popup-fun (guix-command-symbol `(,@commands "popup")))
|
||||
(doc (format "Call `%s' (generate it if needed)."
|
||||
popup-fun)))
|
||||
`(defun ,name (&optional arg)
|
||||
,doc
|
||||
(interactive "P")
|
||||
(unless (fboundp ',popup-fun)
|
||||
(guix-command-generate-popup ',popup-fun ',commands))
|
||||
(,popup-fun arg))))
|
||||
|
||||
(defmacro guix-command-define-execute-action (name executor
|
||||
&optional commands)
|
||||
"Define NAME function to execute the current action for guix COMMANDS.
|
||||
EXECUTOR function is called with the current command line arguments."
|
||||
(declare (indent 1) (debug t))
|
||||
(let* ((arguments-fun (guix-command-symbol `(,@commands "arguments")))
|
||||
(doc (format "Call `%s' with the current popup arguments."
|
||||
executor)))
|
||||
`(defun ,name (&rest args)
|
||||
,doc
|
||||
(interactive (,arguments-fun))
|
||||
(,executor (append ',commands
|
||||
(guix-command-post-process-args
|
||||
',commands args))))))
|
||||
|
||||
(defun guix-command-generate-popup-actions (actions &optional commands)
|
||||
"Generate 'popup' commands from ACTIONS arguments for guix COMMANDS."
|
||||
(dolist (action actions)
|
||||
(let ((fun (guix-command-argument-fun action)))
|
||||
(unless (fboundp fun)
|
||||
(eval `(guix-command-define-popup-action ,fun
|
||||
,(append commands
|
||||
(list (guix-command-argument-name action)))))))))
|
||||
|
||||
(defun guix-command-generate-execute-actions (actions &optional commands)
|
||||
"Generate 'execute' commands from ACTIONS arguments for guix COMMANDS."
|
||||
(dolist (action actions)
|
||||
(let ((fun (guix-command-argument-fun action)))
|
||||
(unless (fboundp fun)
|
||||
(eval `(guix-command-define-execute-action ,fun
|
||||
,(guix-command-executor
|
||||
commands (guix-command-argument-name action))
|
||||
,commands))))))
|
||||
|
||||
(defun guix-command-generate-popup (name &optional commands)
|
||||
"Define NAME popup with 'guix COMMANDS ...' interface."
|
||||
(let* ((command (car commands))
|
||||
(man-page (concat "guix" (and command (concat "-" command))))
|
||||
(doc (format "Popup window for '%s' command."
|
||||
(guix-concat-strings (cons "guix" commands)
|
||||
" ")))
|
||||
(args (guix-command-arguments commands))
|
||||
(switches (guix-command-sort-arguments
|
||||
(guix-command-switches args)))
|
||||
(options (guix-command-sort-arguments
|
||||
(guix-command-options args)))
|
||||
(popup-actions (guix-command-sort-arguments
|
||||
(guix-command-actions args)))
|
||||
(execute-actions (unless popup-actions
|
||||
(guix-command-execute-arguments commands)))
|
||||
(actions (or popup-actions execute-actions)))
|
||||
(if popup-actions
|
||||
(guix-command-generate-popup-actions popup-actions commands)
|
||||
(guix-command-generate-execute-actions execute-actions commands))
|
||||
(eval
|
||||
`(guix-define-popup ,name
|
||||
,doc
|
||||
'guix-commands
|
||||
:man-page ,man-page
|
||||
:switches ',(mapcar #'guix-command-switch->popup-switch switches)
|
||||
:options ',(mapcar #'guix-command-option->popup-option options)
|
||||
:actions ',(mapcar #'guix-command-action->popup-action actions)
|
||||
:max-action-columns 4))))
|
||||
|
||||
;;;###autoload (autoload 'guix "guix-command" "Popup window for 'guix'." t)
|
||||
(guix-command-define-popup-action guix)
|
||||
|
||||
(defalias 'guix-edit-action #'guix-edit)
|
||||
|
||||
|
||||
(defvar guix-command-font-lock-keywords
|
||||
(eval-when-compile
|
||||
`((,(rx "("
|
||||
(group "guix-command-define-"
|
||||
(or "popup-action"
|
||||
"execute-action"
|
||||
"argument-improver"))
|
||||
symbol-end
|
||||
(zero-or-more blank)
|
||||
(zero-or-one
|
||||
(group (one-or-more (or (syntax word) (syntax symbol))))))
|
||||
(1 font-lock-keyword-face)
|
||||
(2 font-lock-function-name-face nil t)))))
|
||||
|
||||
(font-lock-add-keywords 'emacs-lisp-mode guix-command-font-lock-keywords)
|
||||
|
||||
(provide 'guix-command)
|
||||
|
||||
;;; guix-command.el ends here
|
||||
@@ -1,44 +0,0 @@
|
||||
;;; guix-config.el --- Compile-time configuration of Guix.
|
||||
|
||||
;; Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org>
|
||||
;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defconst guix-config-name "@PACKAGE_NAME@"
|
||||
"Guix full name.")
|
||||
|
||||
(defconst guix-config-version "@PACKAGE_VERSION@"
|
||||
"Guix version.")
|
||||
|
||||
(defconst guix-config-emacs-interface-directory
|
||||
(replace-regexp-in-string "${prefix}" "@prefix@" "@emacsuidir@"))
|
||||
|
||||
(defconst guix-config-state-directory
|
||||
;; This must match `NIX_STATE_DIR' as defined in `nix/local.mk'.
|
||||
(or (getenv "NIX_STATE_DIR") "@guix_localstatedir@/guix"))
|
||||
|
||||
(defconst guix-config-guile-program "@GUILE@"
|
||||
"Name of the 'guile' executable defined at configure time.")
|
||||
|
||||
(defconst guix-config-dot-program "@DOT_USER_PROGRAM@"
|
||||
"Name of the 'dot' executable defined at configure time.")
|
||||
|
||||
(provide 'guix-config)
|
||||
|
||||
;;; guix-config.el ends here
|
||||
@@ -1,382 +0,0 @@
|
||||
;;; guix-devel.el --- Development tools -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright © 2015 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides commands useful for developing Guix (or even
|
||||
;; arbitrary Guile code) with Geiser.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'lisp-mode)
|
||||
(require 'guix-guile)
|
||||
(require 'guix-geiser)
|
||||
(require 'guix-utils)
|
||||
(require 'guix-base)
|
||||
|
||||
(defgroup guix-devel nil
|
||||
"Settings for Guix development utils."
|
||||
:group 'guix)
|
||||
|
||||
(defgroup guix-devel-faces nil
|
||||
"Faces for `guix-devel-mode'."
|
||||
:group 'guix-devel
|
||||
:group 'guix-faces)
|
||||
|
||||
(defface guix-devel-modify-phases-keyword
|
||||
'((t :inherit font-lock-preprocessor-face))
|
||||
"Face for a `modify-phases' keyword ('delete', 'replace', etc.)."
|
||||
:group 'guix-devel-faces)
|
||||
|
||||
(defface guix-devel-gexp-symbol
|
||||
'((t :inherit font-lock-keyword-face))
|
||||
"Face for gexp symbols ('#~', '#$', etc.).
|
||||
See Info node `(guix) G-Expressions'."
|
||||
:group 'guix-devel-faces)
|
||||
|
||||
(defcustom guix-devel-activate-mode t
|
||||
"If non-nil, then `guix-devel-mode' is automatically activated
|
||||
in Scheme buffers."
|
||||
:type 'boolean
|
||||
:group 'guix-devel)
|
||||
|
||||
(defun guix-devel-use-modules (&rest modules)
|
||||
"Use guile MODULES."
|
||||
(apply #'guix-geiser-call "use-modules" modules))
|
||||
|
||||
(defun guix-devel-use-module (&optional module)
|
||||
"Use guile MODULE in the current Geiser REPL.
|
||||
MODULE is a string with the module name - e.g., \"(ice-9 match)\".
|
||||
Interactively, use the module defined by the current scheme file."
|
||||
(interactive (list (guix-guile-current-module)))
|
||||
(guix-devel-use-modules module)
|
||||
(message "Using %s module." module))
|
||||
|
||||
(defun guix-devel-copy-module-as-kill ()
|
||||
"Put the name of the current guile module into `kill-ring'."
|
||||
(interactive)
|
||||
(guix-copy-as-kill (guix-guile-current-module)))
|
||||
|
||||
(defun guix-devel-setup-repl (&optional repl)
|
||||
"Setup REPL for using `guix-devel-...' commands."
|
||||
(guix-devel-use-modules "(guix monad-repl)"
|
||||
"(guix scripts)"
|
||||
"(guix store)"
|
||||
"(guix ui)")
|
||||
;; Without this workaround, the warning/build output disappears. See
|
||||
;; <https://github.com/jaor/geiser/issues/83> for details.
|
||||
(guix-geiser-eval-in-repl-synchronously
|
||||
"(begin
|
||||
(guix-warning-port (current-warning-port))
|
||||
(current-build-output-port (current-error-port)))"
|
||||
repl 'no-history 'no-display))
|
||||
|
||||
(defvar guix-devel-repl-processes nil
|
||||
"List of REPL processes configured by `guix-devel-setup-repl'.")
|
||||
|
||||
(defun guix-devel-setup-repl-maybe (&optional repl)
|
||||
"Setup (if needed) REPL for using `guix-devel-...' commands."
|
||||
(let ((process (get-buffer-process (or repl (guix-geiser-repl)))))
|
||||
(when (and process
|
||||
(not (memq process guix-devel-repl-processes)))
|
||||
(guix-devel-setup-repl repl)
|
||||
(push process guix-devel-repl-processes))))
|
||||
|
||||
(defmacro guix-devel-with-definition (def-var &rest body)
|
||||
"Run BODY with the current guile definition bound to DEF-VAR.
|
||||
Bind DEF-VAR variable to the name of the current top-level
|
||||
definition, setup the current REPL, use the current module, and
|
||||
run BODY."
|
||||
(declare (indent 1) (debug (symbolp body)))
|
||||
`(let ((,def-var (guix-guile-current-definition)))
|
||||
(guix-devel-setup-repl-maybe)
|
||||
(guix-devel-use-modules (guix-guile-current-module))
|
||||
,@body))
|
||||
|
||||
(defun guix-devel-build-package-definition ()
|
||||
"Build a package defined by the current top-level variable definition."
|
||||
(interactive)
|
||||
(guix-devel-with-definition def
|
||||
(when (or (not guix-operation-confirm)
|
||||
(guix-operation-prompt (format "Build '%s'?" def)))
|
||||
(guix-geiser-eval-in-repl
|
||||
(concat ",run-in-store "
|
||||
(guix-guile-make-call-expression
|
||||
"build-package" def
|
||||
"#:use-substitutes?" (guix-guile-boolean
|
||||
guix-use-substitutes)
|
||||
"#:dry-run?" (guix-guile-boolean guix-dry-run)))))))
|
||||
|
||||
(defun guix-devel-build-package-source ()
|
||||
"Build the source of the current package definition."
|
||||
(interactive)
|
||||
(guix-devel-with-definition def
|
||||
(when (or (not guix-operation-confirm)
|
||||
(guix-operation-prompt
|
||||
(format "Build '%s' package source?" def)))
|
||||
(guix-geiser-eval-in-repl
|
||||
(concat ",run-in-store "
|
||||
(guix-guile-make-call-expression
|
||||
"build-package-source" def
|
||||
"#:use-substitutes?" (guix-guile-boolean
|
||||
guix-use-substitutes)
|
||||
"#:dry-run?" (guix-guile-boolean guix-dry-run)))))))
|
||||
|
||||
(defun guix-devel-lint-package ()
|
||||
"Check the current package.
|
||||
See Info node `(guix) Invoking guix lint' for details."
|
||||
(interactive)
|
||||
(guix-devel-with-definition def
|
||||
(guix-devel-use-modules "(guix scripts lint)")
|
||||
(when (or (not guix-operation-confirm)
|
||||
(y-or-n-p (format "Lint '%s' package?" def)))
|
||||
(guix-geiser-eval-in-repl
|
||||
(format "(run-checkers %s)" def)))))
|
||||
|
||||
|
||||
;;; Font-lock
|
||||
|
||||
(defvar guix-devel-modify-phases-keyword-regexp
|
||||
(rx (+ word))
|
||||
"Regexp for a 'modify-phases' keyword ('delete', 'replace', etc.).")
|
||||
|
||||
(defun guix-devel-modify-phases-font-lock-matcher (limit)
|
||||
"Find a 'modify-phases' keyword.
|
||||
This function is used as a MATCHER for `font-lock-keywords'."
|
||||
(ignore-errors
|
||||
(down-list)
|
||||
(or (re-search-forward guix-devel-modify-phases-keyword-regexp
|
||||
limit t)
|
||||
(set-match-data nil))
|
||||
(up-list)
|
||||
t))
|
||||
|
||||
(defun guix-devel-modify-phases-font-lock-pre ()
|
||||
"Skip the next sexp, and return the end point of the current list.
|
||||
This function is used as a PRE-MATCH-FORM for `font-lock-keywords'
|
||||
to find 'modify-phases' keywords."
|
||||
(let ((in-comment? (nth 4 (syntax-ppss))))
|
||||
;; If 'modify-phases' is commented, do not try to search for its
|
||||
;; keywords.
|
||||
(unless in-comment?
|
||||
(ignore-errors (forward-sexp))
|
||||
(save-excursion (up-list) (point)))))
|
||||
|
||||
(defconst guix-devel-keywords
|
||||
'("call-with-compressed-output-port"
|
||||
"call-with-container"
|
||||
"call-with-decompressed-port"
|
||||
"call-with-derivation-narinfo"
|
||||
"call-with-derivation-substitute"
|
||||
"call-with-error-handling"
|
||||
"call-with-temporary-directory"
|
||||
"call-with-temporary-output-file"
|
||||
"define-enumerate-type"
|
||||
"define-gexp-compiler"
|
||||
"define-lift"
|
||||
"define-monad"
|
||||
"define-operation"
|
||||
"define-record-type*"
|
||||
"emacs-substitute-sexps"
|
||||
"emacs-substitute-variables"
|
||||
"mbegin"
|
||||
"mlet"
|
||||
"mlet*"
|
||||
"modify-services"
|
||||
"munless"
|
||||
"mwhen"
|
||||
"run-with-state"
|
||||
"run-with-store"
|
||||
"signature-case"
|
||||
"substitute*"
|
||||
"substitute-keyword-arguments"
|
||||
"test-assertm"
|
||||
"use-package-modules"
|
||||
"use-service-modules"
|
||||
"use-system-modules"
|
||||
"with-atomic-file-output"
|
||||
"with-atomic-file-replacement"
|
||||
"with-derivation-narinfo"
|
||||
"with-derivation-substitute"
|
||||
"with-directory-excursion"
|
||||
"with-error-handling"
|
||||
"with-imported-modules"
|
||||
"with-monad"
|
||||
"with-mutex"
|
||||
"with-store"))
|
||||
|
||||
(defvar guix-devel-font-lock-keywords
|
||||
`((,(rx (or "#~" "#$" "#$@" "#+" "#+@")) .
|
||||
'guix-devel-gexp-symbol)
|
||||
(,(guix-guile-keyword-regexp (regexp-opt guix-devel-keywords))
|
||||
(1 'font-lock-keyword-face))
|
||||
(,(guix-guile-keyword-regexp "modify-phases")
|
||||
(1 'font-lock-keyword-face)
|
||||
(guix-devel-modify-phases-font-lock-matcher
|
||||
(guix-devel-modify-phases-font-lock-pre)
|
||||
nil
|
||||
(0 'guix-devel-modify-phases-keyword nil t))))
|
||||
"A list of `font-lock-keywords' for `guix-devel-mode'.")
|
||||
|
||||
|
||||
;;; Indentation
|
||||
|
||||
(defmacro guix-devel-scheme-indent (&rest rules)
|
||||
"Set `scheme-indent-function' according to RULES.
|
||||
Each rule should have a form (SYMBOL VALUE). See `put' for details."
|
||||
(declare (indent 0))
|
||||
`(progn
|
||||
,@(mapcar (lambda (rule)
|
||||
`(put ',(car rule) 'scheme-indent-function ,(cadr rule)))
|
||||
rules)))
|
||||
|
||||
(defun guix-devel-indent-package (state indent-point normal-indent)
|
||||
"Indentation rule for 'package' form."
|
||||
(let* ((package-eol (line-end-position))
|
||||
(count (if (and (ignore-errors (down-list) t)
|
||||
(< (point) package-eol)
|
||||
(looking-at "inherit\\>"))
|
||||
1
|
||||
0)))
|
||||
(lisp-indent-specform count state indent-point normal-indent)))
|
||||
|
||||
(defun guix-devel-indent-modify-phases-keyword (count)
|
||||
"Return indentation function for 'modify-phases' keywords."
|
||||
(lambda (state indent-point normal-indent)
|
||||
(when (ignore-errors
|
||||
(goto-char (nth 1 state)) ; start of keyword sexp
|
||||
(backward-up-list)
|
||||
(looking-at "(modify-phases\\>"))
|
||||
(lisp-indent-specform count state indent-point normal-indent))))
|
||||
|
||||
(defalias 'guix-devel-indent-modify-phases-keyword-1
|
||||
(guix-devel-indent-modify-phases-keyword 1))
|
||||
(defalias 'guix-devel-indent-modify-phases-keyword-2
|
||||
(guix-devel-indent-modify-phases-keyword 2))
|
||||
|
||||
(guix-devel-scheme-indent
|
||||
(bag 0)
|
||||
(build-system 0)
|
||||
(call-with-compressed-output-port 2)
|
||||
(call-with-container 1)
|
||||
(call-with-decompressed-port 2)
|
||||
(call-with-error-handling 0)
|
||||
(container-excursion 1)
|
||||
(emacs-batch-edit-file 1)
|
||||
(emacs-batch-eval 0)
|
||||
(emacs-substitute-sexps 1)
|
||||
(emacs-substitute-variables 1)
|
||||
(file-system 0)
|
||||
(graft 0)
|
||||
(manifest-entry 0)
|
||||
(manifest-pattern 0)
|
||||
(mbegin 1)
|
||||
(mlet 2)
|
||||
(mlet* 2)
|
||||
(modify-phases 1)
|
||||
(modify-services 1)
|
||||
(munless 1)
|
||||
(mwhen 1)
|
||||
(operating-system 0)
|
||||
(origin 0)
|
||||
(package 'guix-devel-indent-package)
|
||||
(run-with-state 1)
|
||||
(run-with-store 1)
|
||||
(signature-case 1)
|
||||
(substitute* 1)
|
||||
(substitute-keyword-arguments 1)
|
||||
(test-assertm 1)
|
||||
(with-atomic-file-output 1)
|
||||
(with-derivation-narinfo 1)
|
||||
(with-derivation-substitute 2)
|
||||
(with-directory-excursion 1)
|
||||
(with-error-handling 0)
|
||||
(with-imported-modules 1)
|
||||
(with-monad 1)
|
||||
(with-mutex 1)
|
||||
(with-store 1)
|
||||
(wrap-program 1)
|
||||
|
||||
;; 'modify-phases' keywords:
|
||||
(replace 'guix-devel-indent-modify-phases-keyword-1)
|
||||
(add-after 'guix-devel-indent-modify-phases-keyword-2)
|
||||
(add-before 'guix-devel-indent-modify-phases-keyword-2))
|
||||
|
||||
|
||||
(defvar guix-devel-keys-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map (kbd "b") 'guix-devel-build-package-definition)
|
||||
(define-key map (kbd "s") 'guix-devel-build-package-source)
|
||||
(define-key map (kbd "l") 'guix-devel-lint-package)
|
||||
(define-key map (kbd "k") 'guix-devel-copy-module-as-kill)
|
||||
(define-key map (kbd "u") 'guix-devel-use-module)
|
||||
map)
|
||||
"Keymap with subkeys for `guix-devel-mode-map'.")
|
||||
|
||||
(defvar guix-devel-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map (kbd "C-c .") guix-devel-keys-map)
|
||||
map)
|
||||
"Keymap for `guix-devel-mode'.")
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode guix-devel-mode
|
||||
"Minor mode for `scheme-mode' buffers.
|
||||
|
||||
With a prefix argument ARG, enable the mode if ARG is positive,
|
||||
and disable it otherwise. If called from Lisp, enable the mode
|
||||
if ARG is omitted or nil.
|
||||
|
||||
When Guix Devel mode is enabled, it provides the following key
|
||||
bindings:
|
||||
|
||||
\\{guix-devel-mode-map}"
|
||||
:init-value nil
|
||||
:lighter " Guix"
|
||||
:keymap guix-devel-mode-map
|
||||
(if guix-devel-mode
|
||||
(progn
|
||||
(setq-local font-lock-multiline t)
|
||||
(font-lock-add-keywords nil guix-devel-font-lock-keywords))
|
||||
(setq-local font-lock-multiline nil)
|
||||
(font-lock-remove-keywords nil guix-devel-font-lock-keywords))
|
||||
(when font-lock-mode
|
||||
(font-lock-fontify-buffer)))
|
||||
|
||||
;;;###autoload
|
||||
(defun guix-devel-activate-mode-maybe ()
|
||||
"Activate `guix-devel-mode' depending on
|
||||
`guix-devel-activate-mode' variable."
|
||||
(when guix-devel-activate-mode
|
||||
(guix-devel-mode)))
|
||||
|
||||
;;;###autoload
|
||||
(add-hook 'scheme-mode-hook 'guix-devel-activate-mode-maybe)
|
||||
|
||||
|
||||
(defvar guix-devel-emacs-font-lock-keywords
|
||||
(eval-when-compile
|
||||
`((,(rx "(" (group "guix-devel-with-definition") symbol-end) . 1))))
|
||||
|
||||
(font-lock-add-keywords 'emacs-lisp-mode
|
||||
guix-devel-emacs-font-lock-keywords)
|
||||
|
||||
(provide 'guix-devel)
|
||||
|
||||
;;; guix-devel.el ends here
|
||||
@@ -1,59 +0,0 @@
|
||||
;;; guix-entry.el --- 'Entry' type -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright © 2015 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides an API for 'entry' type which is just an alist of
|
||||
;; KEY/VALUE pairs (KEY should be a symbol) with the required 'id' KEY.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'guix-utils)
|
||||
|
||||
(defalias 'guix-entry-value #'guix-assq-value)
|
||||
|
||||
(defun guix-entry-id (entry)
|
||||
"Return ENTRY ID."
|
||||
(guix-entry-value entry 'id))
|
||||
|
||||
(defun guix-entry-by-id (id entries)
|
||||
"Return an entry from ENTRIES by its ID."
|
||||
(cl-find-if (lambda (entry)
|
||||
(equal (guix-entry-id entry) id))
|
||||
entries))
|
||||
|
||||
(defun guix-entries-by-ids (ids entries)
|
||||
"Return entries with IDS (a list of identifiers) from ENTRIES."
|
||||
(cl-remove-if-not (lambda (entry)
|
||||
(member (guix-entry-id entry) ids))
|
||||
entries))
|
||||
|
||||
(defun guix-replace-entry (id new-entry entries)
|
||||
"Replace an entry with ID from ENTRIES by NEW-ENTRY.
|
||||
Return a list of entries with the replaced entry."
|
||||
(cl-substitute-if new-entry
|
||||
(lambda (entry)
|
||||
(equal id (guix-entry-id entry)))
|
||||
entries
|
||||
:count 1))
|
||||
|
||||
(provide 'guix-entry)
|
||||
|
||||
;;; guix-entry.el ends here
|
||||
@@ -1,88 +0,0 @@
|
||||
;;; guix-external.el --- External programs -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright © 2015 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides auxiliary code for running external programs.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'guix-config)
|
||||
|
||||
(defgroup guix-external nil
|
||||
"Settings for external programs."
|
||||
:group 'guix)
|
||||
|
||||
(defcustom guix-guile-program guix-config-guile-program
|
||||
"Name of the 'guile' executable used for Guix REPL.
|
||||
May be either a string (the name of the executable) or a list of
|
||||
strings of the form:
|
||||
|
||||
(NAME . ARGS)
|
||||
|
||||
Where ARGS is a list of arguments to the guile program."
|
||||
:type 'string
|
||||
:group 'guix-external)
|
||||
|
||||
(defcustom guix-dot-program
|
||||
(if (file-name-absolute-p guix-config-dot-program)
|
||||
guix-config-dot-program
|
||||
(executable-find "dot"))
|
||||
"Name of the 'dot' executable."
|
||||
:type 'string
|
||||
:group 'guix-external)
|
||||
|
||||
(defcustom guix-dot-default-arguments
|
||||
'("-Tpng")
|
||||
"Default arguments for 'dot' program."
|
||||
:type '(repeat string)
|
||||
:group 'guix-external)
|
||||
|
||||
(defcustom guix-dot-file-name-function #'guix-png-file-name
|
||||
"Function used to define a file name of a temporary 'dot' file.
|
||||
The function is called without arguments."
|
||||
:type '(choice (function-item guix-png-file-name)
|
||||
(function :tag "Other function"))
|
||||
:group 'guix-external)
|
||||
|
||||
(defun guix-dot-arguments (output-file &rest args)
|
||||
"Return a list of dot arguments for writing a graph into OUTPUT-FILE.
|
||||
If ARGS is nil, use `guix-dot-default-arguments'."
|
||||
(or guix-dot-program
|
||||
(error (concat "Couldn't find 'dot'.\n"
|
||||
"Set guix-dot-program to a proper value")))
|
||||
(cl-list* guix-dot-program
|
||||
(concat "-o" output-file)
|
||||
(or args guix-dot-default-arguments)))
|
||||
|
||||
(defun guix-dot-file-name ()
|
||||
"Call `guix-dot-file-name-function'."
|
||||
(funcall guix-dot-file-name-function))
|
||||
|
||||
(defun guix-png-file-name ()
|
||||
"Return '.png' file name in the `temporary-file-directory'."
|
||||
(concat (make-temp-name
|
||||
(concat (file-name-as-directory temporary-file-directory)
|
||||
"guix-emacs-graph-"))
|
||||
".png"))
|
||||
|
||||
(provide 'guix-external)
|
||||
|
||||
;;; guix-external.el ends here
|
||||
@@ -1,126 +0,0 @@
|
||||
;;; guix-geiser.el --- Interacting with Geiser -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright © 2015 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides functions to evaluate guile code using Geiser.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'geiser-mode)
|
||||
(require 'guix-guile)
|
||||
|
||||
(defun guix-geiser-repl ()
|
||||
"Return the current Geiser REPL."
|
||||
(or geiser-repl--repl
|
||||
(geiser-repl--repl/impl 'guile)
|
||||
(error "Geiser REPL not found")))
|
||||
|
||||
(defun guix-geiser-eval (str &optional repl)
|
||||
"Evaluate STR with guile expression using Geiser REPL.
|
||||
If REPL is nil, use the current Geiser REPL.
|
||||
Return a list of strings with result values of evaluation."
|
||||
(with-current-buffer (or repl (guix-geiser-repl))
|
||||
(let ((res (geiser-eval--send/wait `(:eval (:scm ,str)))))
|
||||
(if (geiser-eval--retort-error res)
|
||||
(error "Error in evaluating guile expression: %s"
|
||||
(geiser-eval--retort-output res))
|
||||
(cdr (assq 'result res))))))
|
||||
|
||||
(defun guix-geiser-eval-read (str &optional repl)
|
||||
"Evaluate STR with guile expression using Geiser REPL.
|
||||
Return elisp expression of the first result value of evaluation."
|
||||
;; The goal is to convert a string with scheme expression into elisp
|
||||
;; expression.
|
||||
(let ((result (car (guix-geiser-eval str repl))))
|
||||
(cond
|
||||
((or (string= result "#f")
|
||||
(string= result "#<unspecified>"))
|
||||
nil)
|
||||
((string= result "#t")
|
||||
t)
|
||||
(t
|
||||
(read (replace-regexp-in-string
|
||||
"[ (]\\(#f\\)" "nil"
|
||||
(replace-regexp-in-string
|
||||
"[ (]\\(#t\\)" "t"
|
||||
result
|
||||
nil nil 1)
|
||||
nil nil 1))))))
|
||||
|
||||
(defun guix-repl-send (cmd &optional save-history)
|
||||
"Send CMD input string to the current REPL buffer.
|
||||
This is the same as `geiser-repl--send', but with SAVE-HISTORY
|
||||
argument. If SAVE-HISTORY is non-nil, save CMD in the REPL
|
||||
history."
|
||||
(when (and cmd (eq major-mode 'geiser-repl-mode))
|
||||
(geiser-repl--prepare-send)
|
||||
(goto-char (point-max))
|
||||
(comint-kill-input)
|
||||
(insert cmd)
|
||||
(let ((comint-input-filter (if save-history
|
||||
comint-input-filter
|
||||
'ignore)))
|
||||
(comint-send-input nil t))))
|
||||
|
||||
(defun guix-geiser-eval-in-repl (str &optional repl no-history no-display)
|
||||
"Switch to Geiser REPL and evaluate STR with guile expression there.
|
||||
If NO-HISTORY is non-nil, do not save STR in the REPL history.
|
||||
If NO-DISPLAY is non-nil, do not switch to the REPL buffer."
|
||||
(let ((repl (or repl (guix-geiser-repl))))
|
||||
(with-current-buffer repl
|
||||
;; XXX Since Geiser 0.8, `geiser-repl--send' has SAVE-HISTORY
|
||||
;; argument, so use this function eventually and remove
|
||||
;; `guix-repl-send'.
|
||||
(guix-repl-send str (not no-history)))
|
||||
(unless no-display
|
||||
(geiser-repl--switch-to-buffer repl))))
|
||||
|
||||
(defun guix-geiser-eval-in-repl-synchronously (str &optional repl
|
||||
no-history no-display)
|
||||
"Evaluate STR in Geiser REPL synchronously, i.e. wait until the
|
||||
REPL operation will be finished.
|
||||
See `guix-geiser-eval-in-repl' for the meaning of arguments."
|
||||
(let* ((repl (if repl (get-buffer repl) (guix-geiser-repl)))
|
||||
(running? nil)
|
||||
(filter (lambda (output)
|
||||
(setq running?
|
||||
(and (get-buffer-process repl)
|
||||
(not (guix-guile-prompt? output))))))
|
||||
(comint-output-filter-functions
|
||||
(cons filter comint-output-filter-functions)))
|
||||
(guix-geiser-eval-in-repl str repl no-history no-display)
|
||||
(while running?
|
||||
(sleep-for 0.1))))
|
||||
|
||||
(defun guix-geiser-call (proc &rest args)
|
||||
"Call (PROC ARGS ...) synchronously using the current Geiser REPL.
|
||||
PROC and ARGS should be strings."
|
||||
(guix-geiser-eval
|
||||
(apply #'guix-guile-make-call-expression proc args)))
|
||||
|
||||
(defun guix-geiser-call-in-repl (proc &rest args)
|
||||
"Call (PROC ARGS ...) in the current Geiser REPL.
|
||||
PROC and ARGS should be strings."
|
||||
(guix-geiser-eval-in-repl
|
||||
(apply #'guix-guile-make-call-expression proc args)))
|
||||
|
||||
(provide 'guix-geiser)
|
||||
|
||||
;;; guix-geiser.el ends here
|
||||
@@ -1,98 +0,0 @@
|
||||
;;; guix-guile.el --- Auxiliary tools for working with guile code -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright © 2015 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides functions for parsing guile code, making guile
|
||||
;; expressions, etc.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'geiser-guile)
|
||||
|
||||
(defvar guix-guile-definition-regexp
|
||||
(rx bol "(define"
|
||||
(zero-or-one "*")
|
||||
(zero-or-one "-public")
|
||||
(one-or-more space)
|
||||
(zero-or-one "(")
|
||||
(group (one-or-more (or word (syntax symbol)))))
|
||||
"Regexp used to find the guile definition.")
|
||||
|
||||
(defun guix-guile-current-definition ()
|
||||
"Return string with name of the current top-level guile definition."
|
||||
(save-excursion
|
||||
(beginning-of-defun)
|
||||
(if (looking-at guix-guile-definition-regexp)
|
||||
(match-string-no-properties 1)
|
||||
(error "Couldn't find the current definition"))))
|
||||
|
||||
(defun guix-guile-current-module ()
|
||||
"Return a string with the current guile module.
|
||||
Return nil, if current buffer does not define a module."
|
||||
;; Modified version of `geiser-guile--get-module'.
|
||||
(save-excursion
|
||||
(geiser-syntax--pop-to-top)
|
||||
(when (or (re-search-backward geiser-guile--module-re nil t)
|
||||
(looking-at geiser-guile--library-re)
|
||||
(re-search-forward geiser-guile--module-re nil t))
|
||||
(match-string-no-properties 1))))
|
||||
|
||||
(defun guix-guile-boolean (arg)
|
||||
"Return a string with guile boolean value.
|
||||
Transform elisp ARG (nil or non-nil) to the guile boolean (#f or #t)."
|
||||
(if arg "#t" "#f"))
|
||||
|
||||
(defun guix-guile-keyword-regexp (keyword)
|
||||
"Return regexp to find guile KEYWORD."
|
||||
(format "(\\(%s\\)\\_>" keyword))
|
||||
|
||||
(defun guix-guile-make-call-expression (proc &rest args)
|
||||
"Return \"(PROC ARGS ...)\" string.
|
||||
PROC and ARGS should be strings."
|
||||
(format "(%s %s)"
|
||||
proc
|
||||
(mapconcat #'identity args " ")))
|
||||
|
||||
(defun guix-make-guile-expression (fun &rest args)
|
||||
"Return string containing a guile expression for calling FUN with ARGS."
|
||||
(format "(%S %s)" fun
|
||||
(mapconcat
|
||||
(lambda (arg)
|
||||
(cond
|
||||
((null arg) "'()")
|
||||
((or (eq arg t)
|
||||
;; An ugly hack to separate 'false' from nil.
|
||||
(equal arg 'f)
|
||||
(keywordp arg))
|
||||
(concat "#" (prin1-to-string arg t)))
|
||||
((or (symbolp arg) (listp arg))
|
||||
(concat "'" (prin1-to-string arg)))
|
||||
(t (prin1-to-string arg))))
|
||||
args
|
||||
" ")))
|
||||
|
||||
(defun guix-guile-prompt? (string)
|
||||
"Return non-nil, if STRING contains a Guile prompt."
|
||||
(or (string-match-p geiser-guile--prompt-regexp string)
|
||||
(string-match-p geiser-guile--debugger-prompt-regexp string)))
|
||||
|
||||
(provide 'guix-guile)
|
||||
|
||||
;;; guix-guile.el ends here
|
||||
@@ -1,108 +0,0 @@
|
||||
;;; guix-help-vars.el --- Variables related to --help output
|
||||
|
||||
;; Copyright © 2015 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides regular expressions to parse various "guix
|
||||
;; ... --help" outputs and lists of non-receivable items (system types,
|
||||
;; hash formats, etc.).
|
||||
|
||||
;;; Code:
|
||||
|
||||
|
||||
;;; Regexps for parsing "guix ..." outputs
|
||||
|
||||
(defvar guix-help-parse-option-regexp
|
||||
(rx bol " "
|
||||
(zero-or-one (group "-" (not (any "- ")))
|
||||
",")
|
||||
(one-or-more " ")
|
||||
(group "--" (one-or-more (or wordchar "-")))
|
||||
(group (zero-or-one "[")
|
||||
(zero-or-one "="))
|
||||
(zero-or-more (not space))
|
||||
(one-or-more space)
|
||||
(group (one-or-more any)))
|
||||
"Common regexp used to find command options.")
|
||||
|
||||
(defvar guix-help-parse-command-regexp
|
||||
(rx bol " "
|
||||
(group wordchar (one-or-more (or wordchar "-"))))
|
||||
"Regexp used to find guix commands.
|
||||
'Command' means any option not prefixed with '-'. For example,
|
||||
guix subcommand, system action, importer, etc.")
|
||||
|
||||
(defvar guix-help-parse-long-option-regexp
|
||||
(rx (or " " ", ")
|
||||
(group "--" (one-or-more (or wordchar "-"))
|
||||
(zero-or-one "=")))
|
||||
"Regexp used to find long options.")
|
||||
|
||||
(defvar guix-help-parse-short-option-regexp
|
||||
(rx bol (one-or-more blank)
|
||||
"-" (group (not (any "- "))))
|
||||
"Regexp used to find short options.")
|
||||
|
||||
(defvar guix-help-parse-package-regexp
|
||||
(rx bol (group (one-or-more (not blank))))
|
||||
"Regexp used to find names of the packages.")
|
||||
|
||||
(defvar guix-help-parse-list-regexp
|
||||
(rx bol (zero-or-more blank) "- "
|
||||
(group (one-or-more (or wordchar "-"))))
|
||||
"Regexp used to find various lists (lint checkers, graph types).")
|
||||
|
||||
(defvar guix-help-parse-regexp-group 1
|
||||
"Parenthesized expression of regexps used to find commands and
|
||||
options.")
|
||||
|
||||
|
||||
;;; Non-receivable lists of system types, hash formats, etc.
|
||||
|
||||
(defvar guix-help-system-types
|
||||
'("x86_64-linux" "i686-linux" "armhf-linux" "mips64el-linux")
|
||||
"List of supported systems.")
|
||||
|
||||
(defvar guix-help-source-types
|
||||
'("package" "all" "transitive")
|
||||
"List of supported sources types.")
|
||||
|
||||
(defvar guix-help-hash-formats
|
||||
'("nix-base32" "base32" "base16" "hex" "hexadecimal")
|
||||
"List of supported hash formats.")
|
||||
|
||||
(defvar guix-help-refresh-subsets
|
||||
'("core" "non-core")
|
||||
"List of supported 'refresh' subsets.")
|
||||
|
||||
(defvar guix-help-key-policies
|
||||
'("interactive" "always" "never")
|
||||
"List of supported key download policies.")
|
||||
|
||||
(defvar guix-help-verify-options
|
||||
'("repair" "contents")
|
||||
"List of supported 'verify' options")
|
||||
|
||||
(defvar guix-help-elpa-archives
|
||||
'("gnu" "melpa" "melpa-stable")
|
||||
"List of supported ELPA archives.")
|
||||
|
||||
(provide 'guix-help-vars)
|
||||
|
||||
;;; guix-help-vars.el ends here
|
||||
@@ -1,65 +0,0 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
||||
;;; under the terms of the GNU General Public License as published by
|
||||
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||
;;; your option) any later version.
|
||||
;;;
|
||||
;;; GNU Guix is distributed in the hope that it will be useful, but
|
||||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;;; GNU General Public License for more details.
|
||||
;;;
|
||||
;;; You should have received a copy of the GNU General Public License
|
||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This is an auxiliary file for the Emacs UI. It is used to add Guix
|
||||
;; directories to path variables and to load the main code.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(use-modules (ice-9 regex)
|
||||
(srfi srfi-26))
|
||||
|
||||
(define %guix-dir)
|
||||
|
||||
;; The code is taken from ‘guix’ executable script
|
||||
(define (set-paths!)
|
||||
(define-syntax-rule (push! elt v) (set! v (cons elt v)))
|
||||
|
||||
(define config-lookup
|
||||
(let ((config '(("prefix" . "@prefix@")
|
||||
("guilemoduledir" . "@guilemoduledir@")))
|
||||
(var-ref-regexp (make-regexp "\\$\\{([a-z]+)\\}")))
|
||||
(define (expand-var-ref match)
|
||||
(lookup (match:substring match 1)))
|
||||
(define (expand str)
|
||||
(regexp-substitute/global #f var-ref-regexp str
|
||||
'pre expand-var-ref 'post))
|
||||
(define (lookup name)
|
||||
(expand (assoc-ref config name)))
|
||||
lookup))
|
||||
|
||||
(let ((module-dir (config-lookup "guilemoduledir"))
|
||||
(updates-dir (and=> (or (getenv "XDG_CONFIG_HOME")
|
||||
(and=> (getenv "HOME")
|
||||
(cut string-append <> "/.config")))
|
||||
(cut string-append <> "/guix/latest"))))
|
||||
(push! module-dir %load-path)
|
||||
(push! module-dir %load-compiled-path)
|
||||
(if (and updates-dir (file-exists? updates-dir))
|
||||
(begin
|
||||
(set! %guix-dir updates-dir)
|
||||
(push! updates-dir %load-path)
|
||||
(push! updates-dir %load-compiled-path))
|
||||
(set! %guix-dir module-dir))))
|
||||
|
||||
(set-paths!)
|
||||
|
||||
(load-from-path "guix-main")
|
||||
|
||||
@@ -1,92 +0,0 @@
|
||||
;;; guix-history.el --- History of buffer information
|
||||
|
||||
;; Copyright © 2014 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides support for history of buffers similar to the
|
||||
;; history of a `help-mode' buffer.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-macs)
|
||||
|
||||
(defvar-local guix-history-stack-item nil
|
||||
"Current item of the history.
|
||||
A list of the form (FUNCTION [ARGS ...]).
|
||||
The item is used by calling (apply FUNCTION ARGS).")
|
||||
(put 'guix-history-stack-item 'permanent-local t)
|
||||
|
||||
(defvar-local guix-history-back-stack nil
|
||||
"Stack (list) of visited items.
|
||||
Each element of the list has a form of `guix-history-stack-item'.")
|
||||
(put 'guix-history-back-stack 'permanent-local t)
|
||||
|
||||
(defvar-local guix-history-forward-stack nil
|
||||
"Stack (list) of items visited with `guix-history-back'.
|
||||
Each element of the list has a form of `guix-history-stack-item'.")
|
||||
(put 'guix-history-forward-stack 'permanent-local t)
|
||||
|
||||
(defvar guix-history-size 0
|
||||
"Maximum number of items saved in history.
|
||||
If 0, the history is disabled.")
|
||||
|
||||
(defun guix-history-add (item)
|
||||
"Add ITEM to history."
|
||||
(and guix-history-stack-item
|
||||
(push guix-history-stack-item guix-history-back-stack))
|
||||
(setq guix-history-forward-stack nil
|
||||
guix-history-stack-item item)
|
||||
(when (>= (length guix-history-back-stack)
|
||||
guix-history-size)
|
||||
(setq guix-history-back-stack
|
||||
(cl-loop for elt in guix-history-back-stack
|
||||
for i from 1 to guix-history-size
|
||||
collect elt))))
|
||||
|
||||
(defun guix-history-replace (item)
|
||||
"Replace current item in history with ITEM."
|
||||
(setq guix-history-stack-item item))
|
||||
|
||||
(defun guix-history-goto (item)
|
||||
"Go to the ITEM of history.
|
||||
ITEM should have the form of `guix-history-stack-item'."
|
||||
(or (listp item)
|
||||
(error "Wrong value of history element"))
|
||||
(setq guix-history-stack-item item)
|
||||
(apply (car item) (cdr item)))
|
||||
|
||||
(defun guix-history-back ()
|
||||
"Go back to the previous element of history in the current buffer."
|
||||
(interactive)
|
||||
(or guix-history-back-stack
|
||||
(user-error "No previous element in history"))
|
||||
(push guix-history-stack-item guix-history-forward-stack)
|
||||
(guix-history-goto (pop guix-history-back-stack)))
|
||||
|
||||
(defun guix-history-forward ()
|
||||
"Go forward to the next element of history in the current buffer."
|
||||
(interactive)
|
||||
(or guix-history-forward-stack
|
||||
(user-error "No next element in history"))
|
||||
(push guix-history-stack-item guix-history-back-stack)
|
||||
(guix-history-goto (pop guix-history-forward-stack)))
|
||||
|
||||
(provide 'guix-history)
|
||||
|
||||
;;; guix-history.el ends here
|
||||
@@ -1,362 +0,0 @@
|
||||
;;; guix-hydra-build.el --- Interface for Hydra builds -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright © 2015 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides an interface for displaying Hydra builds in
|
||||
;; 'list' and 'info' buffers.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'guix-buffer)
|
||||
(require 'guix-list)
|
||||
(require 'guix-info)
|
||||
(require 'guix-hydra)
|
||||
(require 'guix-build-log)
|
||||
(require 'guix-utils)
|
||||
|
||||
(guix-hydra-define-entry-type hydra-build
|
||||
:search-types '((latest . guix-hydra-build-latest-api-url)
|
||||
(queue . guix-hydra-build-queue-api-url))
|
||||
:filters '(guix-hydra-build-filter-status)
|
||||
:filter-names '((nixname . name)
|
||||
(buildstatus . build-status)
|
||||
(timestamp . time))
|
||||
:filter-boolean-params '(finished busy))
|
||||
|
||||
(defun guix-hydra-build-get-display (search-type &rest args)
|
||||
"Search for Hydra builds and show results."
|
||||
(apply #'guix-list-get-display-entries
|
||||
'hydra-build search-type args))
|
||||
|
||||
(cl-defun guix-hydra-build-latest-prompt-args (&key project jobset
|
||||
job system)
|
||||
"Prompt for and return a list of 'latest builds' arguments."
|
||||
(let* ((number (read-number "Number of latest builds: "))
|
||||
(project (if current-prefix-arg
|
||||
(guix-hydra-read-project nil project)
|
||||
project))
|
||||
(jobset (if current-prefix-arg
|
||||
(guix-hydra-read-jobset nil jobset)
|
||||
jobset))
|
||||
(job-or-name (if current-prefix-arg
|
||||
(guix-hydra-read-job nil job)
|
||||
job))
|
||||
(job (and job-or-name
|
||||
(string-match-p guix-hydra-job-regexp
|
||||
job-or-name)
|
||||
job-or-name))
|
||||
(system (if (and (not job)
|
||||
(or current-prefix-arg
|
||||
(and job-or-name (not system))))
|
||||
(if job-or-name
|
||||
(guix-while-null
|
||||
(guix-hydra-read-system
|
||||
(concat job-or-name ".") system))
|
||||
(guix-hydra-read-system nil system))
|
||||
system))
|
||||
(job (or job
|
||||
(and job-or-name
|
||||
(concat job-or-name "." system)))))
|
||||
(list number
|
||||
:project project
|
||||
:jobset jobset
|
||||
:job job
|
||||
:system system)))
|
||||
|
||||
(defun guix-hydra-build-view-log (id)
|
||||
"View build log of a hydra build ID."
|
||||
(guix-build-log-find-file (guix-hydra-build-log-url id)))
|
||||
|
||||
|
||||
;;; Defining URLs
|
||||
|
||||
(defun guix-hydra-build-url (id)
|
||||
"Return Hydra URL of a build ID."
|
||||
(guix-hydra-url "build/" (number-to-string id)))
|
||||
|
||||
(defun guix-hydra-build-log-url (id)
|
||||
"Return Hydra URL of the log file of a build ID."
|
||||
(concat (guix-hydra-build-url id) "/log/raw"))
|
||||
|
||||
(cl-defun guix-hydra-build-latest-api-url
|
||||
(number &key project jobset job system)
|
||||
"Return Hydra API URL to receive latest NUMBER of builds."
|
||||
(guix-hydra-api-url "latestbuilds"
|
||||
`(("nr" . ,number)
|
||||
("project" . ,project)
|
||||
("jobset" . ,jobset)
|
||||
("job" . ,job)
|
||||
("system" . ,system))))
|
||||
|
||||
(defun guix-hydra-build-queue-api-url (number)
|
||||
"Return Hydra API URL to receive the NUMBER of queued builds."
|
||||
(guix-hydra-api-url "queue"
|
||||
`(("nr" . ,number))))
|
||||
|
||||
|
||||
;;; Filters for processing raw entries
|
||||
|
||||
(defun guix-hydra-build-filter-status (entry)
|
||||
"Add 'status' parameter to 'hydra-build' ENTRY."
|
||||
(let ((status (if (guix-entry-value entry 'finished)
|
||||
(guix-hydra-build-status-number->name
|
||||
(guix-entry-value entry 'build-status))
|
||||
(if (guix-entry-value entry 'busy)
|
||||
'running
|
||||
'scheduled))))
|
||||
(cons `(status . ,status)
|
||||
entry)))
|
||||
|
||||
|
||||
;;; Build status
|
||||
|
||||
(defface guix-hydra-build-status-running
|
||||
'((t :inherit bold))
|
||||
"Face used if hydra build is not finished."
|
||||
:group 'guix-hydra-build-faces)
|
||||
|
||||
(defface guix-hydra-build-status-scheduled
|
||||
'((t))
|
||||
"Face used if hydra build is scheduled."
|
||||
:group 'guix-hydra-build-faces)
|
||||
|
||||
(defface guix-hydra-build-status-succeeded
|
||||
'((t :inherit success))
|
||||
"Face used if hydra build succeeded."
|
||||
:group 'guix-hydra-build-faces)
|
||||
|
||||
(defface guix-hydra-build-status-cancelled
|
||||
'((t :inherit warning))
|
||||
"Face used if hydra build was cancelled."
|
||||
:group 'guix-hydra-build-faces)
|
||||
|
||||
(defface guix-hydra-build-status-failed
|
||||
'((t :inherit error))
|
||||
"Face used if hydra build failed."
|
||||
:group 'guix-hydra-build-faces)
|
||||
|
||||
(defvar guix-hydra-build-status-alist
|
||||
'((0 . succeeded)
|
||||
(1 . failed-build)
|
||||
(2 . failed-dependency)
|
||||
(3 . failed-other)
|
||||
(4 . cancelled))
|
||||
"Alist of hydra build status numbers and status names.
|
||||
Status numbers are returned by Hydra API, names (symbols) are
|
||||
used internally by the elisp code of this package.")
|
||||
|
||||
(defun guix-hydra-build-status-number->name (number)
|
||||
"Convert build status number to a name.
|
||||
See `guix-hydra-build-status-alist'."
|
||||
(guix-assq-value guix-hydra-build-status-alist number))
|
||||
|
||||
(defun guix-hydra-build-status-string (status)
|
||||
"Return a human readable string for build STATUS."
|
||||
(cl-case status
|
||||
(scheduled
|
||||
(guix-get-string "Scheduled" 'guix-hydra-build-status-scheduled))
|
||||
(running
|
||||
(guix-get-string "Running" 'guix-hydra-build-status-running))
|
||||
(succeeded
|
||||
(guix-get-string "Succeeded" 'guix-hydra-build-status-succeeded))
|
||||
(cancelled
|
||||
(guix-get-string "Cancelled" 'guix-hydra-build-status-cancelled))
|
||||
(failed-build
|
||||
(guix-hydra-build-status-fail-string))
|
||||
(failed-dependency
|
||||
(guix-hydra-build-status-fail-string "dependency"))
|
||||
(failed-other
|
||||
(guix-hydra-build-status-fail-string "other"))))
|
||||
|
||||
(defun guix-hydra-build-status-fail-string (&optional reason)
|
||||
"Return a string for a failed build."
|
||||
(let ((base (guix-get-string "Failed" 'guix-hydra-build-status-failed)))
|
||||
(if reason
|
||||
(concat base " (" reason ")")
|
||||
base)))
|
||||
|
||||
(defun guix-hydra-build-finished? (entry)
|
||||
"Return non-nil, if hydra build was finished."
|
||||
(guix-entry-value entry 'finished))
|
||||
|
||||
(defun guix-hydra-build-running? (entry)
|
||||
"Return non-nil, if hydra build is running."
|
||||
(eq (guix-entry-value entry 'status)
|
||||
'running))
|
||||
|
||||
(defun guix-hydra-build-scheduled? (entry)
|
||||
"Return non-nil, if hydra build is scheduled."
|
||||
(eq (guix-entry-value entry 'status)
|
||||
'scheduled))
|
||||
|
||||
(defun guix-hydra-build-succeeded? (entry)
|
||||
"Return non-nil, if hydra build succeeded."
|
||||
(eq (guix-entry-value entry 'status)
|
||||
'succeeded))
|
||||
|
||||
(defun guix-hydra-build-cancelled? (entry)
|
||||
"Return non-nil, if hydra build was cancelled."
|
||||
(eq (guix-entry-value entry 'status)
|
||||
'cancelled))
|
||||
|
||||
(defun guix-hydra-build-failed? (entry)
|
||||
"Return non-nil, if hydra build failed."
|
||||
(memq (guix-entry-value entry 'status)
|
||||
'(failed-build failed-dependency failed-other)))
|
||||
|
||||
|
||||
;;; Hydra build 'info'
|
||||
|
||||
(guix-hydra-info-define-interface hydra-build
|
||||
:mode-name "Hydra-Build-Info"
|
||||
:buffer-name "*Guix Hydra Build Info*"
|
||||
:format '((name ignore (simple guix-info-heading))
|
||||
ignore
|
||||
guix-hydra-build-info-insert-url
|
||||
(time format (time))
|
||||
(status format guix-hydra-build-info-insert-status)
|
||||
(project format (format guix-hydra-build-project))
|
||||
(jobset format (format guix-hydra-build-jobset))
|
||||
(job format (format guix-hydra-build-job))
|
||||
(system format (format guix-hydra-build-system))
|
||||
(priority format (format))))
|
||||
|
||||
(defface guix-hydra-build-info-project
|
||||
'((t :inherit link))
|
||||
"Face for project names."
|
||||
:group 'guix-hydra-build-info-faces)
|
||||
|
||||
(defface guix-hydra-build-info-jobset
|
||||
'((t :inherit link))
|
||||
"Face for jobsets."
|
||||
:group 'guix-hydra-build-info-faces)
|
||||
|
||||
(defface guix-hydra-build-info-job
|
||||
'((t :inherit link))
|
||||
"Face for jobs."
|
||||
:group 'guix-hydra-build-info-faces)
|
||||
|
||||
(defface guix-hydra-build-info-system
|
||||
'((t :inherit link))
|
||||
"Face for system names."
|
||||
:group 'guix-hydra-build-info-faces)
|
||||
|
||||
(defmacro guix-hydra-build-define-button (name)
|
||||
"Define `guix-hydra-build-NAME' button."
|
||||
(let* ((name-str (symbol-name name))
|
||||
(button-name (intern (concat "guix-hydra-build-" name-str)))
|
||||
(face-name (intern (concat "guix-hydra-build-info-" name-str)))
|
||||
(keyword (intern (concat ":" name-str))))
|
||||
`(define-button-type ',button-name
|
||||
:supertype 'guix
|
||||
'face ',face-name
|
||||
'help-echo ,(format "\
|
||||
Show latest builds for this %s (with prefix, prompt for all parameters)"
|
||||
name-str)
|
||||
'action (lambda (btn)
|
||||
(let ((args (guix-hydra-build-latest-prompt-args
|
||||
,keyword (button-label btn))))
|
||||
(apply #'guix-hydra-build-get-display
|
||||
'latest args))))))
|
||||
|
||||
(guix-hydra-build-define-button project)
|
||||
(guix-hydra-build-define-button jobset)
|
||||
(guix-hydra-build-define-button job)
|
||||
(guix-hydra-build-define-button system)
|
||||
|
||||
(defun guix-hydra-build-info-insert-url (entry)
|
||||
"Insert Hydra URL for the build ENTRY."
|
||||
(guix-insert-button (guix-hydra-build-url (guix-entry-id entry))
|
||||
'guix-url)
|
||||
(when (guix-hydra-build-finished? entry)
|
||||
(guix-info-insert-indent)
|
||||
(guix-info-insert-action-button
|
||||
"Build log"
|
||||
(lambda (btn)
|
||||
(guix-hydra-build-view-log (button-get btn 'id)))
|
||||
"View build log"
|
||||
'id (guix-entry-id entry))))
|
||||
|
||||
(defun guix-hydra-build-info-insert-status (status &optional _)
|
||||
"Insert a string with build STATUS."
|
||||
(insert (guix-hydra-build-status-string status)))
|
||||
|
||||
|
||||
;;; Hydra build 'list'
|
||||
|
||||
(guix-hydra-list-define-interface hydra-build
|
||||
:mode-name "Hydra-Build-List"
|
||||
:buffer-name "*Guix Hydra Build List*"
|
||||
:format '((name nil 30 t)
|
||||
(system nil 16 t)
|
||||
(status guix-hydra-build-list-get-status 20 t)
|
||||
(project nil 10 t)
|
||||
(jobset nil 17 t)
|
||||
(time guix-list-get-time 20 t)))
|
||||
|
||||
(let ((map guix-hydra-build-list-mode-map))
|
||||
(define-key map (kbd "B") 'guix-hydra-build-list-latest-builds)
|
||||
(define-key map (kbd "L") 'guix-hydra-build-list-view-log))
|
||||
|
||||
(defun guix-hydra-build-list-get-status (status &optional _)
|
||||
"Return a string for build STATUS."
|
||||
(guix-hydra-build-status-string status))
|
||||
|
||||
(defun guix-hydra-build-list-latest-builds (number &rest args)
|
||||
"Display latest NUMBER of Hydra builds of the current job.
|
||||
Interactively, prompt for NUMBER. With prefix argument, prompt
|
||||
for all ARGS."
|
||||
(interactive
|
||||
(let ((entry (guix-list-current-entry)))
|
||||
(guix-hydra-build-latest-prompt-args
|
||||
:project (guix-entry-value entry 'project)
|
||||
:jobset (guix-entry-value entry 'name)
|
||||
:job (guix-entry-value entry 'job)
|
||||
:system (guix-entry-value entry 'system))))
|
||||
(apply #'guix-hydra-latest-builds number args))
|
||||
|
||||
(defun guix-hydra-build-list-view-log ()
|
||||
"View build log of the current Hydra build."
|
||||
(interactive)
|
||||
(guix-hydra-build-view-log (guix-list-current-id)))
|
||||
|
||||
|
||||
;;; Interactive commands
|
||||
|
||||
;;;###autoload
|
||||
(defun guix-hydra-latest-builds (number &rest args)
|
||||
"Display latest NUMBER of Hydra builds.
|
||||
ARGS are the same arguments as for `guix-hydra-build-latest-api-url'.
|
||||
Interactively, prompt for NUMBER. With prefix argument, prompt
|
||||
for all ARGS."
|
||||
(interactive (guix-hydra-build-latest-prompt-args))
|
||||
(apply #'guix-hydra-build-get-display
|
||||
'latest number args))
|
||||
|
||||
;;;###autoload
|
||||
(defun guix-hydra-queued-builds (number)
|
||||
"Display the NUMBER of queued Hydra builds."
|
||||
(interactive "NNumber of queued builds: ")
|
||||
(guix-hydra-build-get-display 'queue number))
|
||||
|
||||
(provide 'guix-hydra-build)
|
||||
|
||||
;;; guix-hydra-build.el ends here
|
||||
@@ -1,162 +0,0 @@
|
||||
;;; guix-hydra-jobset.el --- Interface for Hydra jobsets -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright © 2015 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides an interface for displaying Hydra jobsets in
|
||||
;; 'list' and 'info' buffers.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'guix-buffer)
|
||||
(require 'guix-list)
|
||||
(require 'guix-info)
|
||||
(require 'guix-hydra)
|
||||
(require 'guix-hydra-build)
|
||||
(require 'guix-utils)
|
||||
|
||||
(guix-hydra-define-entry-type hydra-jobset
|
||||
:search-types '((project . guix-hydra-jobset-api-url))
|
||||
:filters '(guix-hydra-jobset-filter-id)
|
||||
:filter-names '((nrscheduled . scheduled)
|
||||
(nrsucceeded . succeeded)
|
||||
(nrfailed . failed)
|
||||
(nrtotal . total)))
|
||||
|
||||
(defun guix-hydra-jobset-get-display (search-type &rest args)
|
||||
"Search for Hydra builds and show results."
|
||||
(apply #'guix-list-get-display-entries
|
||||
'hydra-jobset search-type args))
|
||||
|
||||
|
||||
;;; Defining URLs
|
||||
|
||||
(defun guix-hydra-jobset-url (project jobset)
|
||||
"Return Hydra URL of a PROJECT's JOBSET."
|
||||
(guix-hydra-url "jobset/" project "/" jobset))
|
||||
|
||||
(defun guix-hydra-jobset-api-url (project)
|
||||
"Return Hydra API URL for jobsets by PROJECT."
|
||||
(guix-hydra-api-url "jobsets"
|
||||
`(("project" . ,project))))
|
||||
|
||||
|
||||
;;; Filters for processing raw entries
|
||||
|
||||
(defun guix-hydra-jobset-filter-id (entry)
|
||||
"Add 'ID' parameter to 'hydra-jobset' ENTRY."
|
||||
(cons `(id . ,(guix-entry-value entry 'name))
|
||||
entry))
|
||||
|
||||
|
||||
;;; Hydra jobset 'info'
|
||||
|
||||
(guix-hydra-info-define-interface hydra-jobset
|
||||
:mode-name "Hydra-Jobset-Info"
|
||||
:buffer-name "*Guix Hydra Jobset Info*"
|
||||
:format '((name ignore (simple guix-info-heading))
|
||||
ignore
|
||||
guix-hydra-jobset-info-insert-url
|
||||
(project format guix-hydra-jobset-info-insert-project)
|
||||
(scheduled format (format guix-hydra-jobset-info-scheduled))
|
||||
(succeeded format (format guix-hydra-jobset-info-succeeded))
|
||||
(failed format (format guix-hydra-jobset-info-failed))
|
||||
(total format (format guix-hydra-jobset-info-total))))
|
||||
|
||||
(defface guix-hydra-jobset-info-scheduled
|
||||
'((t))
|
||||
"Face used for the number of scheduled builds."
|
||||
:group 'guix-hydra-jobset-info-faces)
|
||||
|
||||
(defface guix-hydra-jobset-info-succeeded
|
||||
'((t :inherit guix-hydra-build-status-succeeded))
|
||||
"Face used for the number of succeeded builds."
|
||||
:group 'guix-hydra-jobset-info-faces)
|
||||
|
||||
(defface guix-hydra-jobset-info-failed
|
||||
'((t :inherit guix-hydra-build-status-failed))
|
||||
"Face used for the number of failed builds."
|
||||
:group 'guix-hydra-jobset-info-faces)
|
||||
|
||||
(defface guix-hydra-jobset-info-total
|
||||
'((t))
|
||||
"Face used for the total number of builds."
|
||||
:group 'guix-hydra-jobset-info-faces)
|
||||
|
||||
(defun guix-hydra-jobset-info-insert-project (project entry)
|
||||
"Insert PROJECT button for the jobset ENTRY."
|
||||
(let ((jobset (guix-entry-value entry 'name)))
|
||||
(guix-insert-button
|
||||
project 'guix-hydra-build-project
|
||||
'action (lambda (btn)
|
||||
(let ((args (guix-hydra-build-latest-prompt-args
|
||||
:project (button-get btn 'project)
|
||||
:jobset (button-get btn 'jobset))))
|
||||
(apply #'guix-hydra-build-get-display
|
||||
'latest args)))
|
||||
'project project
|
||||
'jobset jobset)))
|
||||
|
||||
(defun guix-hydra-jobset-info-insert-url (entry)
|
||||
"Insert Hydra URL for the jobset ENTRY."
|
||||
(guix-insert-button (guix-hydra-jobset-url
|
||||
(guix-entry-value entry 'project)
|
||||
(guix-entry-value entry 'name))
|
||||
'guix-url))
|
||||
|
||||
|
||||
;;; Hydra jobset 'list'
|
||||
|
||||
(guix-hydra-list-define-interface hydra-jobset
|
||||
:mode-name "Hydra-Jobset-List"
|
||||
:buffer-name "*Guix Hydra Jobset List*"
|
||||
:format '((name nil 25 t)
|
||||
(project nil 10 t)
|
||||
(scheduled nil 12 t)
|
||||
(succeeded nil 12 t)
|
||||
(failed nil 9 t)
|
||||
(total nil 10 t)))
|
||||
|
||||
(let ((map guix-hydra-jobset-list-mode-map))
|
||||
(define-key map (kbd "B") 'guix-hydra-jobset-list-latest-builds))
|
||||
|
||||
(defun guix-hydra-jobset-list-latest-builds (number &rest args)
|
||||
"Display latest NUMBER of Hydra builds of the current jobset.
|
||||
Interactively, prompt for NUMBER. With prefix argument, prompt
|
||||
for all ARGS."
|
||||
(interactive
|
||||
(let ((entry (guix-list-current-entry)))
|
||||
(guix-hydra-build-latest-prompt-args
|
||||
:project (guix-entry-value entry 'project)
|
||||
:jobset (guix-entry-value entry 'name))))
|
||||
(apply #'guix-hydra-latest-builds number args))
|
||||
|
||||
|
||||
;;; Interactive commands
|
||||
|
||||
;;;###autoload
|
||||
(defun guix-hydra-jobsets (project)
|
||||
"Display jobsets of PROJECT."
|
||||
(interactive (list (guix-hydra-read-project)))
|
||||
(guix-hydra-jobset-get-display 'project project))
|
||||
|
||||
(provide 'guix-hydra-jobset)
|
||||
|
||||
;;; guix-hydra-jobset.el ends here
|
||||
@@ -1,367 +0,0 @@
|
||||
;;; guix-hydra.el --- Common code for interacting with Hydra -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright © 2015 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides some general code for 'list'/'info' interfaces for
|
||||
;; Hydra (Guix build farm).
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'json)
|
||||
(require 'guix-buffer)
|
||||
(require 'guix-entry)
|
||||
(require 'guix-utils)
|
||||
(require 'guix-help-vars)
|
||||
|
||||
(guix-define-groups hydra)
|
||||
|
||||
(defvar guix-hydra-job-regexp
|
||||
(concat ".*\\." (regexp-opt guix-help-system-types) "\\'")
|
||||
"Regexp matching a full name of Hydra job (including system).")
|
||||
|
||||
(defun guix-hydra-job-name-specification (name version)
|
||||
"Return Hydra's job name specification by NAME and VERSION."
|
||||
(concat name "-" version))
|
||||
|
||||
(defun guix-hydra-message (entries search-type &rest _)
|
||||
"Display a message after showing Hydra ENTRIES."
|
||||
;; XXX Add more messages maybe.
|
||||
(when (null entries)
|
||||
(if (eq search-type 'fake)
|
||||
(message "The update is impossible due to lack of Hydra API.")
|
||||
(message "Hydra has returned no results."))))
|
||||
|
||||
(defun guix-hydra-list-describe (ids)
|
||||
"Describe 'hydra' entries with IDS (list of identifiers)."
|
||||
(guix-buffer-display-entries
|
||||
(guix-entries-by-ids ids (guix-buffer-current-entries))
|
||||
'info (guix-buffer-current-entry-type)
|
||||
;; Hydra does not provide an API to receive builds/jobsets by
|
||||
;; IDs/names, so we use a 'fake' search type.
|
||||
'(fake)
|
||||
'add))
|
||||
|
||||
|
||||
;;; Readers
|
||||
|
||||
(defvar guix-hydra-projects
|
||||
'("gnu" "guix")
|
||||
"List of available Hydra projects.")
|
||||
|
||||
(guix-define-readers
|
||||
:completions-var guix-hydra-projects
|
||||
:single-reader guix-hydra-read-project
|
||||
:single-prompt "Project: ")
|
||||
|
||||
(guix-define-readers
|
||||
:single-reader guix-hydra-read-jobset
|
||||
:single-prompt "Jobset: ")
|
||||
|
||||
(guix-define-readers
|
||||
:single-reader guix-hydra-read-job
|
||||
:single-prompt "Job: ")
|
||||
|
||||
(guix-define-readers
|
||||
:completions-var guix-help-system-types
|
||||
:single-reader guix-hydra-read-system
|
||||
:single-prompt "System: ")
|
||||
|
||||
|
||||
;;; Defining URLs
|
||||
|
||||
(defvar guix-hydra-url "http://hydra.gnu.org"
|
||||
"URL of the Hydra build farm.")
|
||||
|
||||
(defun guix-hydra-url (&rest url-parts)
|
||||
"Return Hydra URL."
|
||||
(apply #'concat guix-hydra-url "/" url-parts))
|
||||
|
||||
(defun guix-hydra-api-url (type args)
|
||||
"Return URL for receiving data using Hydra API.
|
||||
TYPE is the name of an allowed method.
|
||||
ARGS is alist of (KEY . VALUE) pairs.
|
||||
Skip ARG, if VALUE is nil or an empty string."
|
||||
(declare (indent 1))
|
||||
(let* ((fields (mapcar
|
||||
(lambda (arg)
|
||||
(pcase arg
|
||||
(`(,key . ,value)
|
||||
(unless (or (null value)
|
||||
(equal "" value))
|
||||
(concat (guix-hexify key) "="
|
||||
(guix-hexify value))))
|
||||
(_ (error "Wrong argument '%s'" arg))))
|
||||
args))
|
||||
(fields (mapconcat #'identity (delq nil fields) "&")))
|
||||
(guix-hydra-url "api/" type "?" fields)))
|
||||
|
||||
|
||||
;;; Receiving data from Hydra
|
||||
|
||||
(defun guix-hydra-receive-data (url)
|
||||
"Return output received from URL and processed with `json-read'."
|
||||
(with-temp-buffer
|
||||
(url-insert-file-contents url)
|
||||
(goto-char (point-min))
|
||||
(let ((json-key-type 'symbol)
|
||||
(json-array-type 'list)
|
||||
(json-object-type 'alist))
|
||||
(json-read))))
|
||||
|
||||
(defun guix-hydra-get-entries (entry-type search-type &rest args)
|
||||
"Receive ENTRY-TYPE entries from Hydra.
|
||||
SEARCH-TYPE is one of the types defined by `guix-hydra-define-interface'."
|
||||
(unless (eq search-type 'fake)
|
||||
(let* ((url (apply #'guix-hydra-search-url
|
||||
entry-type search-type args))
|
||||
(raw-entries (guix-hydra-receive-data url))
|
||||
(entries (guix-hydra-filter-entries
|
||||
raw-entries
|
||||
(guix-hydra-filters entry-type))))
|
||||
entries)))
|
||||
|
||||
|
||||
;;; Filters for processing raw entries
|
||||
|
||||
(defun guix-hydra-filter-entries (entries filters)
|
||||
"Filter ENTRIES using FILTERS.
|
||||
Call `guix-modify' on each entry from ENTRIES."
|
||||
(mapcar (lambda (entry)
|
||||
(guix-modify entry filters))
|
||||
entries))
|
||||
|
||||
(defun guix-hydra-filter-names (entry name-alist)
|
||||
"Replace names of ENTRY parameters using NAME-ALIST.
|
||||
Each element of NAME-ALIST is (OLD-NAME . NEW-NAME) pair."
|
||||
(mapcar (lambda (param)
|
||||
(pcase param
|
||||
(`(,name . ,val)
|
||||
(let ((new-name (guix-assq-value name-alist name)))
|
||||
(if new-name
|
||||
(cons new-name val)
|
||||
param)))))
|
||||
entry))
|
||||
|
||||
(defun guix-hydra-filter-boolean (entry params)
|
||||
"Convert number PARAMS (0/1) of ENTRY to boolean values (nil/t)."
|
||||
(mapcar (lambda (param)
|
||||
(pcase param
|
||||
(`(,name . ,val)
|
||||
(if (memq name params)
|
||||
(cons name (guix-number->bool val))
|
||||
param))))
|
||||
entry))
|
||||
|
||||
|
||||
;;; Wrappers for defined variables
|
||||
|
||||
(defvar guix-hydra-entry-type-data nil
|
||||
"Alist with hydra entry type data.
|
||||
This alist is filled by `guix-hydra-define-entry-type' macro.")
|
||||
|
||||
(defun guix-hydra-entry-type-value (entry-type symbol)
|
||||
"Return SYMBOL's value for ENTRY-TYPE from `guix-hydra'."
|
||||
(symbol-value (guix-assq-value guix-hydra-entry-type-data
|
||||
entry-type symbol)))
|
||||
|
||||
(defun guix-hydra-search-url (entry-type search-type &rest args)
|
||||
"Return URL to receive ENTRY-TYPE entries from Hydra."
|
||||
(apply (guix-assq-value (guix-hydra-entry-type-value
|
||||
entry-type 'search-types)
|
||||
search-type)
|
||||
args))
|
||||
|
||||
(defun guix-hydra-filters (entry-type)
|
||||
"Return a list of filters for ENTRY-TYPE."
|
||||
(guix-hydra-entry-type-value entry-type 'filters))
|
||||
|
||||
|
||||
;;; Interface definers
|
||||
|
||||
(defmacro guix-hydra-define-entry-type (entry-type &rest args)
|
||||
"Define general code for ENTRY-TYPE.
|
||||
Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
|
||||
|
||||
Required keywords:
|
||||
|
||||
- `:search-types' - default value of the generated
|
||||
`guix-ENTRY-TYPE-search-types' variable.
|
||||
|
||||
Optional keywords:
|
||||
|
||||
- `:filters' - default value of the generated
|
||||
`guix-ENTRY-TYPE-filters' variable.
|
||||
|
||||
- `:filter-names' - if specified, a generated
|
||||
`guix-ENTRY-TYPE-filter-names' function for filtering these
|
||||
names will be added to `guix-ENTRY-TYPE-filters' variable.
|
||||
|
||||
- `:filter-boolean-params' - if specified, a generated
|
||||
`guix-ENTRY-TYPE-filter-boolean' function for filtering these
|
||||
names will be added to `guix-ENTRY-TYPE-filters' variable.
|
||||
|
||||
The rest keyword arguments are passed to
|
||||
`guix-define-entry-type' macro."
|
||||
(declare (indent 1))
|
||||
(let* ((entry-type-str (symbol-name entry-type))
|
||||
(prefix (concat "guix-" entry-type-str))
|
||||
(search-types-var (intern (concat prefix "-search-types")))
|
||||
(filters-var (intern (concat prefix "-filters")))
|
||||
(get-fun (intern (concat prefix "-get-entries"))))
|
||||
(guix-keyword-args-let args
|
||||
((search-types-val :search-types)
|
||||
(filters-val :filters)
|
||||
(filter-names-val :filter-names)
|
||||
(filter-bool-val :filter-boolean-params))
|
||||
`(progn
|
||||
(defvar ,search-types-var ,search-types-val
|
||||
,(format "\
|
||||
Alist of search types and according URL functions.
|
||||
Functions are used to define URL to receive '%s' entries."
|
||||
entry-type-str))
|
||||
|
||||
(defvar ,filters-var ,filters-val
|
||||
,(format "\
|
||||
List of filters for '%s' parameters.
|
||||
Each filter is a function that should take an entry as a single
|
||||
argument, and should also return an entry."
|
||||
entry-type-str))
|
||||
|
||||
,(when filter-bool-val
|
||||
(let ((filter-bool-var (intern (concat prefix
|
||||
"-filter-boolean-params")))
|
||||
(filter-bool-fun (intern (concat prefix
|
||||
"-filter-boolean"))))
|
||||
`(progn
|
||||
(defvar ,filter-bool-var ,filter-bool-val
|
||||
,(format "\
|
||||
List of '%s' parameters that should be transformed to boolean values."
|
||||
entry-type-str))
|
||||
|
||||
(defun ,filter-bool-fun (entry)
|
||||
,(format "\
|
||||
Run `guix-hydra-filter-boolean' with `%S' variable."
|
||||
filter-bool-var)
|
||||
(guix-hydra-filter-boolean entry ,filter-bool-var))
|
||||
|
||||
(setq ,filters-var
|
||||
(cons ',filter-bool-fun ,filters-var)))))
|
||||
|
||||
;; Do not move this clause up!: name filtering should be
|
||||
;; performed before any other filtering, so this filter should
|
||||
;; be consed after the boolean filter.
|
||||
,(when filter-names-val
|
||||
(let* ((filter-names-var (intern (concat prefix
|
||||
"-filter-names")))
|
||||
(filter-names-fun filter-names-var))
|
||||
`(progn
|
||||
(defvar ,filter-names-var ,filter-names-val
|
||||
,(format "\
|
||||
Alist of '%s' parameter names returned by Hydra API and names
|
||||
used internally by the elisp code of this package."
|
||||
entry-type-str))
|
||||
|
||||
(defun ,filter-names-fun (entry)
|
||||
,(format "\
|
||||
Run `guix-hydra-filter-names' with `%S' variable."
|
||||
filter-names-var)
|
||||
(guix-hydra-filter-names entry ,filter-names-var))
|
||||
|
||||
(setq ,filters-var
|
||||
(cons ',filter-names-fun ,filters-var)))))
|
||||
|
||||
(defun ,get-fun (search-type &rest args)
|
||||
,(format "\
|
||||
Receive '%s' entries.
|
||||
See `guix-hydra-get-entries' for details."
|
||||
entry-type-str)
|
||||
(apply #'guix-hydra-get-entries
|
||||
',entry-type search-type args))
|
||||
|
||||
(guix-alist-put!
|
||||
'((search-types . ,search-types-var)
|
||||
(filters . ,filters-var))
|
||||
'guix-hydra-entry-type-data ',entry-type)
|
||||
|
||||
(guix-define-entry-type ,entry-type
|
||||
:parent-group guix-hydra
|
||||
:parent-faces-group guix-hydra-faces
|
||||
,@%foreign-args)))))
|
||||
|
||||
(defmacro guix-hydra-define-interface (buffer-type entry-type &rest args)
|
||||
"Define BUFFER-TYPE interface for displaying ENTRY-TYPE entries.
|
||||
|
||||
This macro should be called after calling
|
||||
`guix-hydra-define-entry-type' with the same ENTRY-TYPE.
|
||||
|
||||
ARGS are passed to `guix-BUFFER-TYPE-define-interface' macro."
|
||||
(declare (indent 2))
|
||||
(let* ((entry-type-str (symbol-name entry-type))
|
||||
(buffer-type-str (symbol-name buffer-type))
|
||||
(get-fun (intern (concat "guix-" entry-type-str
|
||||
"-get-entries")))
|
||||
(definer (intern (concat "guix-" buffer-type-str
|
||||
"-define-interface"))))
|
||||
`(,definer ,entry-type
|
||||
:get-entries-function ',get-fun
|
||||
:message-function 'guix-hydra-message
|
||||
,@args)))
|
||||
|
||||
(defmacro guix-hydra-info-define-interface (entry-type &rest args)
|
||||
"Define 'info' interface for displaying ENTRY-TYPE entries.
|
||||
See `guix-hydra-define-interface'."
|
||||
(declare (indent 1))
|
||||
`(guix-hydra-define-interface info ,entry-type
|
||||
,@args))
|
||||
|
||||
(defmacro guix-hydra-list-define-interface (entry-type &rest args)
|
||||
"Define 'list' interface for displaying ENTRY-TYPE entries.
|
||||
Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
|
||||
|
||||
Optional keywords:
|
||||
|
||||
- `:describe-function' - default value of the generated
|
||||
`guix-ENTRY-TYPE-list-describe-function' variable (if not
|
||||
specified, use `guix-hydra-list-describe').
|
||||
|
||||
The rest keyword arguments are passed to
|
||||
`guix-hydra-define-interface' macro."
|
||||
(declare (indent 1))
|
||||
(guix-keyword-args-let args
|
||||
((describe-val :describe-function))
|
||||
`(guix-hydra-define-interface list ,entry-type
|
||||
:describe-function ,(or describe-val ''guix-hydra-list-describe)
|
||||
,@args)))
|
||||
|
||||
|
||||
(defvar guix-hydra-font-lock-keywords
|
||||
(eval-when-compile
|
||||
`((,(rx "(" (group (or "guix-hydra-define-entry-type"
|
||||
"guix-hydra-define-interface"
|
||||
"guix-hydra-info-define-interface"
|
||||
"guix-hydra-list-define-interface"))
|
||||
symbol-end)
|
||||
. 1))))
|
||||
|
||||
(font-lock-add-keywords 'emacs-lisp-mode guix-hydra-font-lock-keywords)
|
||||
|
||||
(provide 'guix-hydra)
|
||||
|
||||
;;; guix-hydra.el ends here
|
||||
@@ -1,482 +0,0 @@
|
||||
;;; guix-info.el --- 'Info' buffer interface for displaying data -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
|
||||
;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides 'info' (help-like) buffer interface for displaying
|
||||
;; an arbitrary data.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'guix-buffer)
|
||||
(require 'guix-entry)
|
||||
(require 'guix-utils)
|
||||
|
||||
(guix-define-buffer-type info)
|
||||
|
||||
(defface guix-info-heading
|
||||
'((((type tty pc) (class color)) :weight bold)
|
||||
(t :height 1.6 :weight bold :inherit variable-pitch))
|
||||
"Face for headings."
|
||||
:group 'guix-info-faces)
|
||||
|
||||
(defface guix-info-param-title
|
||||
'((t :inherit font-lock-type-face))
|
||||
"Face used for titles of parameters."
|
||||
:group 'guix-info-faces)
|
||||
|
||||
(defface guix-info-file-name
|
||||
'((t :inherit link))
|
||||
"Face used for file names."
|
||||
:group 'guix-info-faces)
|
||||
|
||||
(defface guix-info-url
|
||||
'((t :inherit link))
|
||||
"Face used for URLs."
|
||||
:group 'guix-info-faces)
|
||||
|
||||
(defface guix-info-time
|
||||
'((t :inherit font-lock-constant-face))
|
||||
"Face used for timestamps."
|
||||
:group 'guix-info-faces)
|
||||
|
||||
(defface guix-info-action-button
|
||||
'((((type x w32 ns) (class color))
|
||||
:box (:line-width 2 :style released-button)
|
||||
:background "lightgrey" :foreground "black")
|
||||
(t :inherit button))
|
||||
"Face used for action buttons."
|
||||
:group 'guix-info-faces)
|
||||
|
||||
(defface guix-info-action-button-mouse
|
||||
'((((type x w32 ns) (class color))
|
||||
:box (:line-width 2 :style released-button)
|
||||
:background "grey90" :foreground "black")
|
||||
(t :inherit highlight))
|
||||
"Mouse face used for action buttons."
|
||||
:group 'guix-info-faces)
|
||||
|
||||
(defcustom guix-info-ignore-empty-values nil
|
||||
"If non-nil, do not display parameters with nil values."
|
||||
:type 'boolean
|
||||
:group 'guix-info)
|
||||
|
||||
(defcustom guix-info-fill t
|
||||
"If non-nil, fill string parameters to fit the window.
|
||||
If nil, insert text parameters (like synopsis or description) in
|
||||
a raw form."
|
||||
:type 'boolean
|
||||
:group 'guix-info)
|
||||
|
||||
(defvar guix-info-param-title-format "%-18s: "
|
||||
"String used to format a title of a parameter.
|
||||
It should be a '%s'-sequence. After inserting a title formatted
|
||||
with this string, a value of the parameter is inserted.
|
||||
This string is used by `guix-info-insert-title-format'.")
|
||||
|
||||
(defvar guix-info-multiline-prefix
|
||||
(make-string (length (format guix-info-param-title-format " "))
|
||||
?\s)
|
||||
"String used to format multi-line parameter values.
|
||||
If a value occupies more than one line, this string is inserted
|
||||
in the beginning of each line after the first one.
|
||||
This string is used by `guix-info-insert-value-format'.")
|
||||
|
||||
(defvar guix-info-indent 2
|
||||
"Number of spaces used to indent various parts of inserted text.")
|
||||
|
||||
(defvar guix-info-delimiter "\n\f\n"
|
||||
"String used to separate entries.")
|
||||
|
||||
|
||||
;;; Wrappers for 'info' variables
|
||||
|
||||
(defvar guix-info-data nil
|
||||
"Alist with 'info' data.
|
||||
This alist is filled by `guix-info-define-interface' macro.")
|
||||
|
||||
(defun guix-info-value (entry-type symbol)
|
||||
"Return SYMBOL's value for ENTRY-TYPE from `guix-info-data'."
|
||||
(symbol-value (guix-assq-value guix-info-data entry-type symbol)))
|
||||
|
||||
(defun guix-info-param-title (entry-type param)
|
||||
"Return a title of an ENTRY-TYPE parameter PARAM."
|
||||
(guix-buffer-param-title 'info entry-type param))
|
||||
|
||||
(defun guix-info-format (entry-type)
|
||||
"Return 'info' format for ENTRY-TYPE."
|
||||
(guix-info-value entry-type 'format))
|
||||
|
||||
(defun guix-info-displayed-params (entry-type)
|
||||
"Return a list of ENTRY-TYPE parameters that should be displayed."
|
||||
(delq nil
|
||||
(mapcar (lambda (spec)
|
||||
(pcase spec
|
||||
(`(,param . ,_) param)))
|
||||
(guix-info-format entry-type))))
|
||||
|
||||
|
||||
;;; Inserting entries
|
||||
|
||||
(defvar guix-info-title-aliases
|
||||
'((format . guix-info-insert-title-format)
|
||||
(simple . guix-info-insert-title-simple))
|
||||
"Alist of aliases and functions to insert titles.")
|
||||
|
||||
(defvar guix-info-value-aliases
|
||||
'((format . guix-info-insert-value-format)
|
||||
(indent . guix-info-insert-value-indent)
|
||||
(simple . guix-info-insert-value-simple)
|
||||
(time . guix-info-insert-time))
|
||||
"Alist of aliases and functions to insert values.")
|
||||
|
||||
(defun guix-info-title-function (fun-or-alias)
|
||||
"Convert FUN-OR-ALIAS into a function to insert a title."
|
||||
(or (guix-assq-value guix-info-title-aliases fun-or-alias)
|
||||
fun-or-alias))
|
||||
|
||||
(defun guix-info-value-function (fun-or-alias)
|
||||
"Convert FUN-OR-ALIAS into a function to insert a value."
|
||||
(or (guix-assq-value guix-info-value-aliases fun-or-alias)
|
||||
fun-or-alias))
|
||||
|
||||
(defun guix-info-title-method->function (method)
|
||||
"Convert title METHOD into a function to insert a title."
|
||||
(pcase method
|
||||
((pred null) #'ignore)
|
||||
((pred symbolp) (guix-info-title-function method))
|
||||
(`(,fun-or-alias . ,rest-args)
|
||||
(lambda (title)
|
||||
(apply (guix-info-title-function fun-or-alias)
|
||||
title rest-args)))
|
||||
(_ (error "Unknown title method '%S'" method))))
|
||||
|
||||
(defun guix-info-value-method->function (method)
|
||||
"Convert value METHOD into a function to insert a value."
|
||||
(pcase method
|
||||
((pred null) #'ignore)
|
||||
((pred functionp) method)
|
||||
(`(,fun-or-alias . ,rest-args)
|
||||
(lambda (value _)
|
||||
(apply (guix-info-value-function fun-or-alias)
|
||||
value rest-args)))
|
||||
(_ (error "Unknown value method '%S'" method))))
|
||||
|
||||
(defun guix-info-fill-column ()
|
||||
"Return fill column for the current window."
|
||||
(min (window-width) fill-column))
|
||||
|
||||
(defun guix-info-get-indent (&optional level)
|
||||
"Return `guix-info-indent' \"multiplied\" by LEVEL spaces.
|
||||
LEVEL is 1 by default."
|
||||
(make-string (* guix-info-indent (or level 1)) ?\s))
|
||||
|
||||
(defun guix-info-insert-indent (&optional level)
|
||||
"Insert `guix-info-indent' spaces LEVEL times (1 by default)."
|
||||
(insert (guix-info-get-indent level)))
|
||||
|
||||
(defun guix-info-insert-entries (entries entry-type)
|
||||
"Display ENTRY-TYPE ENTRIES in the current info buffer."
|
||||
(guix-mapinsert (lambda (entry)
|
||||
(guix-info-insert-entry entry entry-type))
|
||||
entries
|
||||
guix-info-delimiter))
|
||||
|
||||
(defun guix-info-insert-entry (entry entry-type &optional indent-level)
|
||||
"Insert ENTRY of ENTRY-TYPE into the current info buffer.
|
||||
If INDENT-LEVEL is non-nil, indent displayed data by this number
|
||||
of `guix-info-indent' spaces."
|
||||
(guix-with-indent (* (or indent-level 0)
|
||||
guix-info-indent)
|
||||
(dolist (spec (guix-info-format entry-type))
|
||||
(guix-info-insert-entry-unit spec entry entry-type))))
|
||||
|
||||
(defun guix-info-insert-entry-unit (format-spec entry entry-type)
|
||||
"Insert title and value of a PARAM at point.
|
||||
ENTRY is alist with parameters and their values.
|
||||
ENTRY-TYPE is a type of ENTRY."
|
||||
(pcase format-spec
|
||||
((pred functionp)
|
||||
(funcall format-spec entry)
|
||||
(insert "\n"))
|
||||
(`(,param ,title-method ,value-method)
|
||||
(let ((value (guix-entry-value entry param)))
|
||||
(unless (and guix-info-ignore-empty-values (null value))
|
||||
(let ((title (guix-info-param-title entry-type param))
|
||||
(insert-title (guix-info-title-method->function title-method))
|
||||
(insert-value (guix-info-value-method->function value-method)))
|
||||
(funcall insert-title title)
|
||||
(funcall insert-value value entry)
|
||||
(insert "\n")))))
|
||||
(_ (error "Unknown format specification '%S'" format-spec))))
|
||||
|
||||
(defun guix-info-insert-title-simple (title &optional face)
|
||||
"Insert \"TITLE: \" string at point.
|
||||
If FACE is nil, use `guix-info-param-title'."
|
||||
(guix-format-insert title
|
||||
(or face 'guix-info-param-title)
|
||||
"%s: "))
|
||||
|
||||
(defun guix-info-insert-title-format (title &optional face)
|
||||
"Insert TITLE using `guix-info-param-title-format' at point.
|
||||
If FACE is nil, use `guix-info-param-title'."
|
||||
(guix-format-insert title
|
||||
(or face 'guix-info-param-title)
|
||||
guix-info-param-title-format))
|
||||
|
||||
(defun guix-info-insert-value-simple (value &optional button-or-face indent)
|
||||
"Format and insert parameter VALUE at point.
|
||||
|
||||
VALUE may be split into several short lines to fit the current
|
||||
window, depending on `guix-info-fill', and each line is indented
|
||||
with INDENT number of spaces.
|
||||
|
||||
If BUTTON-OR-FACE is a button type symbol, transform VALUE into
|
||||
this (these) button(s) and insert each one on a new line. If it
|
||||
is a face symbol, propertize inserted line(s) with this face."
|
||||
(or indent (setq indent 0))
|
||||
(guix-with-indent indent
|
||||
(let* ((button? (guix-button-type? button-or-face))
|
||||
(face (unless button? button-or-face))
|
||||
(fill-col (unless (or button?
|
||||
(and (stringp value)
|
||||
(not guix-info-fill)))
|
||||
(- (guix-info-fill-column) indent)))
|
||||
(value (if (and value button?)
|
||||
(guix-buttonize value button-or-face "\n")
|
||||
value)))
|
||||
(guix-split-insert value face fill-col "\n"))))
|
||||
|
||||
(defun guix-info-insert-value-indent (value &optional button-or-face)
|
||||
"Format and insert parameter VALUE at point.
|
||||
|
||||
This function is intended to be called after inserting a title
|
||||
with `guix-info-insert-title-simple'.
|
||||
|
||||
VALUE may be split into several short lines to fit the current
|
||||
window, depending on `guix-info-fill', and each line is indented
|
||||
with `guix-info-indent'.
|
||||
|
||||
For the meaning of BUTTON-OR-FACE, see `guix-info-insert-value-simple'."
|
||||
(when value (insert "\n"))
|
||||
(guix-info-insert-value-simple value button-or-face guix-info-indent))
|
||||
|
||||
(defun guix-info-insert-value-format (value &optional button-or-face
|
||||
&rest button-properties)
|
||||
"Format and insert parameter VALUE at point.
|
||||
|
||||
This function is intended to be called after inserting a title
|
||||
with `guix-info-insert-title-format'.
|
||||
|
||||
VALUE may be split into several short lines to fit the current
|
||||
window, depending on `guix-info-fill' and
|
||||
`guix-info-multiline-prefix'. If VALUE is a list, its elements
|
||||
will be separated with `guix-list-separator'.
|
||||
|
||||
If BUTTON-OR-FACE is a button type symbol, transform VALUE into
|
||||
this (these) button(s). If it is a face symbol, propertize
|
||||
inserted line(s) with this face.
|
||||
|
||||
BUTTON-PROPERTIES are passed to `guix-buttonize' (only if
|
||||
BUTTON-OR-FACE is a button type)."
|
||||
(let* ((button? (guix-button-type? button-or-face))
|
||||
(face (unless button? button-or-face))
|
||||
(fill-col (when (or button?
|
||||
guix-info-fill
|
||||
(not (stringp value)))
|
||||
(- (guix-info-fill-column)
|
||||
(length guix-info-multiline-prefix))))
|
||||
(value (if (and value button?)
|
||||
(apply #'guix-buttonize
|
||||
value button-or-face guix-list-separator
|
||||
button-properties)
|
||||
value)))
|
||||
(guix-split-insert value face fill-col
|
||||
(concat "\n" guix-info-multiline-prefix))))
|
||||
|
||||
(defun guix-info-insert-time (seconds &optional face)
|
||||
"Insert formatted time string using SECONDS at point."
|
||||
(guix-format-insert (guix-get-time-string seconds)
|
||||
(or face 'guix-info-time)))
|
||||
|
||||
|
||||
;;; Buttons
|
||||
|
||||
(defvar guix-info-button-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map button-map)
|
||||
(define-key map (kbd "c") 'guix-info-button-copy-label)
|
||||
map)
|
||||
"Keymap for buttons in info buffers.")
|
||||
|
||||
(define-button-type 'guix
|
||||
'keymap guix-info-button-map
|
||||
'follow-link t)
|
||||
|
||||
(define-button-type 'guix-action
|
||||
:supertype 'guix
|
||||
'face 'guix-info-action-button
|
||||
'mouse-face 'guix-info-action-button-mouse)
|
||||
|
||||
(define-button-type 'guix-file
|
||||
:supertype 'guix
|
||||
'face 'guix-info-file-name
|
||||
'help-echo "Find file"
|
||||
'action (lambda (btn)
|
||||
(guix-find-file (button-label btn))))
|
||||
|
||||
(define-button-type 'guix-url
|
||||
:supertype 'guix
|
||||
'face 'guix-info-url
|
||||
'help-echo "Browse URL"
|
||||
'action (lambda (btn)
|
||||
(browse-url (button-label btn))))
|
||||
|
||||
(defun guix-info-button-copy-label (&optional pos)
|
||||
"Copy a label of the button at POS into kill ring.
|
||||
If POS is nil, use the current point position."
|
||||
(interactive)
|
||||
(let ((button (button-at (or pos (point)))))
|
||||
(when button
|
||||
(guix-copy-as-kill (button-label button)))))
|
||||
|
||||
(defun guix-info-insert-action-button (label action &optional message
|
||||
&rest properties)
|
||||
"Make action button with LABEL and insert it at point.
|
||||
ACTION is a function called when the button is pressed. It
|
||||
should accept button as the argument.
|
||||
MESSAGE is a button message.
|
||||
See `insert-text-button' for the meaning of PROPERTIES."
|
||||
(apply #'guix-insert-button
|
||||
label 'guix-action
|
||||
'action action
|
||||
'help-echo message
|
||||
properties))
|
||||
|
||||
|
||||
;;; Major mode and interface definer
|
||||
|
||||
(defvar guix-info-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent
|
||||
map (make-composed-keymap (list guix-buffer-map button-buffer-map)
|
||||
special-mode-map))
|
||||
map)
|
||||
"Keymap for `guix-info-mode' buffers.")
|
||||
|
||||
(define-derived-mode guix-info-mode special-mode "Guix-Info"
|
||||
"Parent mode for displaying data in 'info' form."
|
||||
(setq-local revert-buffer-function 'guix-buffer-revert))
|
||||
|
||||
(defun guix-info-mode-initialize ()
|
||||
"Set up the current 'info' buffer."
|
||||
;; Without this, syntactic fontification is performed, and it may
|
||||
;; break our highlighting. For example, description of "emacs-typo"
|
||||
;; package contains a single " (double-quote) character, so the
|
||||
;; default syntactic fontification highlights the rest text after it
|
||||
;; as a string. See (info "(elisp) Font Lock Basics") for details.
|
||||
(setq font-lock-defaults '(nil t)))
|
||||
|
||||
(defmacro guix-info-define-interface (entry-type &rest args)
|
||||
"Define 'info' interface for displaying ENTRY-TYPE entries.
|
||||
Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
|
||||
|
||||
Required keywords:
|
||||
|
||||
- `:format' - default value of the generated
|
||||
`guix-ENTRY-TYPE-info-format' variable.
|
||||
|
||||
The rest keyword arguments are passed to
|
||||
`guix-buffer-define-interface' macro."
|
||||
(declare (indent 1))
|
||||
(let* ((entry-type-str (symbol-name entry-type))
|
||||
(prefix (concat "guix-" entry-type-str "-info"))
|
||||
(group (intern prefix))
|
||||
(format-var (intern (concat prefix "-format"))))
|
||||
(guix-keyword-args-let args
|
||||
((show-entries-val :show-entries-function)
|
||||
(format-val :format))
|
||||
`(progn
|
||||
(defcustom ,format-var ,format-val
|
||||
,(format "\
|
||||
List of methods for inserting '%s' entry.
|
||||
Each METHOD should be either a function or should have the
|
||||
following form:
|
||||
|
||||
(PARAM INSERT-TITLE INSERT-VALUE)
|
||||
|
||||
If METHOD is a function, it is called with an entry as argument.
|
||||
|
||||
PARAM is a name of '%s' entry parameter.
|
||||
|
||||
INSERT-TITLE may be either a symbol or a list. If it is a
|
||||
symbol, it should be a function or an alias from
|
||||
`guix-info-title-aliases', in which case it is called with title
|
||||
as argument. If it is a list, it should have a
|
||||
form (FUN-OR-ALIAS [ARGS ...]), in which case FUN-OR-ALIAS is
|
||||
called with title and ARGS as arguments.
|
||||
|
||||
INSERT-VALUE may be either a symbol or a list. If it is a
|
||||
symbol, it should be a function or an alias from
|
||||
`guix-info-value-aliases', in which case it is called with value
|
||||
and entry as arguments. If it is a list, it should have a
|
||||
form (FUN-OR-ALIAS [ARGS ...]), in which case FUN-OR-ALIAS is
|
||||
called with value and ARGS as arguments.
|
||||
|
||||
Parameters are inserted in the same order as defined by this list.
|
||||
After calling each METHOD, a new line is inserted."
|
||||
entry-type-str entry-type-str)
|
||||
:type 'sexp
|
||||
:group ',group)
|
||||
|
||||
(guix-alist-put!
|
||||
'((format . ,format-var))
|
||||
'guix-info-data ',entry-type)
|
||||
|
||||
,(if show-entries-val
|
||||
`(guix-buffer-define-interface info ,entry-type
|
||||
:show-entries-function ,show-entries-val
|
||||
,@%foreign-args)
|
||||
|
||||
(let ((insert-fun (intern (concat prefix "-insert-entries"))))
|
||||
`(progn
|
||||
(defun ,insert-fun (entries)
|
||||
,(format "\
|
||||
Print '%s' ENTRIES in the current 'info' buffer."
|
||||
entry-type-str)
|
||||
(guix-info-insert-entries entries ',entry-type))
|
||||
|
||||
(guix-buffer-define-interface info ,entry-type
|
||||
:insert-entries-function ',insert-fun
|
||||
:mode-init-function 'guix-info-mode-initialize
|
||||
,@%foreign-args))))))))
|
||||
|
||||
|
||||
(defvar guix-info-font-lock-keywords
|
||||
(eval-when-compile
|
||||
`((,(rx "(" (group "guix-info-define-interface")
|
||||
symbol-end)
|
||||
. 1))))
|
||||
|
||||
(font-lock-add-keywords 'emacs-lisp-mode guix-info-font-lock-keywords)
|
||||
|
||||
(provide 'guix-info)
|
||||
|
||||
;;; guix-info.el ends here
|
||||
@@ -1,3 +0,0 @@
|
||||
(require 'guix-autoloads)
|
||||
(message "(require 'guix-init) is obsolete, use (require 'guix-autoloads) instead.")
|
||||
(provide 'guix-init)
|
||||
@@ -1,65 +0,0 @@
|
||||
;;; guix-license.el --- Licenses
|
||||
|
||||
;; Copyright © 2016 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides the code to work with licenses of Guix packages.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'guix-read)
|
||||
(require 'guix-backend)
|
||||
(require 'guix-guile)
|
||||
|
||||
(defun guix-license-file (&optional directory)
|
||||
"Return name of the file with license definitions.
|
||||
DIRECTORY is a directory with Guix source (`guix-directory' by default)."
|
||||
(expand-file-name "guix/licenses.scm"
|
||||
(or directory guix-directory)))
|
||||
|
||||
(defun guix-lookup-license-url (license)
|
||||
"Return URL of a LICENSE."
|
||||
(or (guix-eval-read (guix-make-guile-expression
|
||||
'lookup-license-uri license))
|
||||
(error "Hm, I don't know URL of '%s' license" license)))
|
||||
|
||||
;;;###autoload
|
||||
(defun guix-find-license-definition (license &optional directory)
|
||||
"Open licenses file from DIRECTORY and move to the LICENSE definition.
|
||||
See `guix-license-file' for the meaning of DIRECTORY.
|
||||
Interactively, with prefix argument, prompt for DIRECTORY."
|
||||
(interactive
|
||||
(list (guix-read-license-name)
|
||||
(guix-read-directory)))
|
||||
(find-file (guix-license-file directory))
|
||||
(goto-char (point-min))
|
||||
(when (re-search-forward (concat "\"" (regexp-quote license) "\"")
|
||||
nil t)
|
||||
(beginning-of-defun)
|
||||
(recenter 1)))
|
||||
|
||||
;;;###autoload
|
||||
(defun guix-browse-license-url (license)
|
||||
"Browse URL of a LICENSE."
|
||||
(interactive (list (guix-read-license-name)))
|
||||
(browse-url (guix-lookup-license-url license)))
|
||||
|
||||
(provide 'guix-license)
|
||||
|
||||
;;; guix-license.el ends here
|
||||
@@ -1,585 +0,0 @@
|
||||
;;; guix-list.el --- 'List' buffer interface for displaying data -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides 'list' buffer interface for displaying an arbitrary
|
||||
;; data.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'tabulated-list)
|
||||
(require 'guix-buffer)
|
||||
(require 'guix-info)
|
||||
(require 'guix-entry)
|
||||
(require 'guix-utils)
|
||||
|
||||
(guix-define-buffer-type list)
|
||||
|
||||
(defface guix-list-file-name
|
||||
'((t :inherit guix-info-file-name))
|
||||
"Face used for file names."
|
||||
:group 'guix-list-faces)
|
||||
|
||||
(defface guix-list-url
|
||||
'((t :inherit guix-info-url))
|
||||
"Face used for URLs."
|
||||
:group 'guix-list-faces)
|
||||
|
||||
(defface guix-list-time
|
||||
'((t :inherit guix-info-time))
|
||||
"Face used for time stamps."
|
||||
:group 'guix-list-faces)
|
||||
|
||||
(defun guix-list-describe (&optional mark-names)
|
||||
"Describe entries marked with a general mark.
|
||||
'Describe' means display entries in 'info' buffer.
|
||||
If no entries are marked, describe the current entry.
|
||||
With prefix argument, describe entries marked with any mark."
|
||||
(interactive (list (unless current-prefix-arg '(general))))
|
||||
(let* ((ids (or (apply #'guix-list-get-marked-id-list mark-names)
|
||||
(list (guix-list-current-id))))
|
||||
(count (length ids))
|
||||
(entry-type (guix-buffer-current-entry-type)))
|
||||
(when (or (<= count (guix-list-describe-warning-count entry-type))
|
||||
(y-or-n-p (format "Do you really want to describe %d entries? "
|
||||
count)))
|
||||
(guix-list-describe-entries entry-type ids))))
|
||||
|
||||
|
||||
;;; Wrappers for 'list' variables
|
||||
|
||||
(defvar guix-list-data nil
|
||||
"Alist with 'list' data.
|
||||
This alist is filled by `guix-list-define-interface' macro.")
|
||||
|
||||
(defun guix-list-value (entry-type symbol)
|
||||
"Return SYMBOL's value for ENTRY-TYPE from `guix-list-data'."
|
||||
(symbol-value (guix-assq-value guix-list-data entry-type symbol)))
|
||||
|
||||
(defun guix-list-param-title (entry-type param)
|
||||
"Return column title of an ENTRY-TYPE parameter PARAM."
|
||||
(guix-buffer-param-title 'list entry-type param))
|
||||
|
||||
(defun guix-list-format (entry-type)
|
||||
"Return column format for ENTRY-TYPE."
|
||||
(guix-list-value entry-type 'format))
|
||||
|
||||
(defun guix-list-displayed-params (entry-type)
|
||||
"Return a list of ENTRY-TYPE parameters that should be displayed."
|
||||
(mapcar #'car (guix-list-format entry-type)))
|
||||
|
||||
(defun guix-list-sort-key (entry-type)
|
||||
"Return sort key for ENTRY-TYPE."
|
||||
(guix-list-value entry-type 'sort-key))
|
||||
|
||||
(defun guix-list-additional-marks (entry-type)
|
||||
"Return alist of additional marks for ENTRY-TYPE."
|
||||
(guix-list-value entry-type 'marks))
|
||||
|
||||
(defun guix-list-single-entry? (entry-type)
|
||||
"Return non-nil, if a single entry of ENTRY-TYPE should be listed."
|
||||
(guix-list-value entry-type 'list-single))
|
||||
|
||||
(defun guix-list-describe-warning-count (entry-type)
|
||||
"Return the maximum number of ENTRY-TYPE entries to describe."
|
||||
(guix-list-value entry-type 'describe-count))
|
||||
|
||||
(defun guix-list-describe-entries (entry-type ids)
|
||||
"Describe ENTRY-TYPE entries with IDS in 'info' buffer"
|
||||
(funcall (guix-list-value entry-type 'describe)
|
||||
ids))
|
||||
|
||||
|
||||
;;; Tabulated list internals
|
||||
|
||||
(defun guix-list-sort-numerically (column a b)
|
||||
"Compare COLUMN of tabulated entries A and B numerically.
|
||||
This function is used for sort predicates for `tabulated-list-format'.
|
||||
Return non-nil, if B is bigger than A."
|
||||
(cl-flet ((num (entry)
|
||||
(string-to-number (aref (cadr entry) column))))
|
||||
(> (num b) (num a))))
|
||||
|
||||
(defmacro guix-list-define-numerical-sorter (column)
|
||||
"Define numerical sort predicate for COLUMN.
|
||||
See `guix-list-sort-numerically' for details."
|
||||
(let ((name (intern (format "guix-list-sort-numerically-%d" column)))
|
||||
(doc (format "\
|
||||
Predicate to sort tabulated list by column %d numerically.
|
||||
See `guix-list-sort-numerically' for details."
|
||||
column)))
|
||||
`(defun ,name (a b)
|
||||
,doc
|
||||
(guix-list-sort-numerically ,column a b))))
|
||||
|
||||
(defmacro guix-list-define-numerical-sorters (n)
|
||||
"Define numerical sort predicates for columns from 0 to N.
|
||||
See `guix-list-define-numerical-sorter' for details."
|
||||
`(progn
|
||||
,@(mapcar (lambda (i)
|
||||
`(guix-list-define-numerical-sorter ,i))
|
||||
(number-sequence 0 n))))
|
||||
|
||||
(guix-list-define-numerical-sorters 9)
|
||||
|
||||
(defun guix-list-tabulated-sort-key (entry-type)
|
||||
"Return ENTRY-TYPE sort key for `tabulated-list-sort-key'."
|
||||
(let ((sort-key (guix-list-sort-key entry-type)))
|
||||
(and sort-key
|
||||
(cons (guix-list-param-title entry-type (car sort-key))
|
||||
(cdr sort-key)))))
|
||||
|
||||
(defun guix-list-tabulated-vector (entry-type fun)
|
||||
"Call FUN on each column specification for ENTRY-TYPE.
|
||||
|
||||
FUN is applied to column specification as arguments (see
|
||||
`guix-list-format').
|
||||
|
||||
Return a vector made of values of FUN calls."
|
||||
(apply #'vector
|
||||
(mapcar (lambda (col-spec)
|
||||
(apply fun col-spec))
|
||||
(guix-list-format entry-type))))
|
||||
|
||||
(defun guix-list-tabulated-format (entry-type)
|
||||
"Return ENTRY-TYPE list specification for `tabulated-list-format'."
|
||||
(guix-list-tabulated-vector
|
||||
entry-type
|
||||
(lambda (param _ &rest rest-spec)
|
||||
(cons (guix-list-param-title entry-type param)
|
||||
rest-spec))))
|
||||
|
||||
(defun guix-list-tabulated-entries (entries entry-type)
|
||||
"Return a list of ENTRY-TYPE values for `tabulated-list-entries'."
|
||||
(mapcar (lambda (entry)
|
||||
(list (guix-entry-id entry)
|
||||
(guix-list-tabulated-entry entry entry-type)))
|
||||
entries))
|
||||
|
||||
(defun guix-list-tabulated-entry (entry entry-type)
|
||||
"Return array of values for `tabulated-list-entries'.
|
||||
Parameters are taken from ENTRY-TYPE ENTRY."
|
||||
(guix-list-tabulated-vector
|
||||
entry-type
|
||||
(lambda (param fun &rest _)
|
||||
(let ((val (guix-entry-value entry param)))
|
||||
(if fun
|
||||
(funcall fun val entry)
|
||||
(guix-get-string val))))))
|
||||
|
||||
|
||||
;;; Displaying entries
|
||||
|
||||
(defun guix-list-get-display-entries (entry-type &rest args)
|
||||
"Search for entries and show them in a 'list' buffer preferably."
|
||||
(let ((entries (guix-buffer-get-entries 'list entry-type args)))
|
||||
(if (or (null entries) ; = 0
|
||||
(cdr entries) ; > 1
|
||||
(guix-list-single-entry? entry-type)
|
||||
(null (guix-buffer-value 'info entry-type 'show-entries)))
|
||||
(guix-buffer-display-entries entries 'list entry-type args 'add)
|
||||
(if (equal (guix-buffer-value 'info entry-type 'get-entries)
|
||||
(guix-buffer-value 'list entry-type 'get-entries))
|
||||
(guix-buffer-display-entries entries 'info entry-type args 'add)
|
||||
(guix-buffer-get-display-entries 'info entry-type args 'add)))))
|
||||
|
||||
(defun guix-list-insert-entries (entries entry-type)
|
||||
"Print ENTRY-TYPE ENTRIES in the current buffer."
|
||||
(setq tabulated-list-entries
|
||||
(guix-list-tabulated-entries entries entry-type))
|
||||
(tabulated-list-print))
|
||||
|
||||
(defun guix-list-get-one-line (val &optional _)
|
||||
"Return one-line string from a multi-line string VAL.
|
||||
VAL may be nil."
|
||||
(if val
|
||||
(guix-get-one-line val)
|
||||
(guix-get-string nil)))
|
||||
|
||||
(defun guix-list-get-time (seconds &optional _)
|
||||
"Return formatted time string from SECONDS."
|
||||
(guix-get-string (guix-get-time-string seconds)
|
||||
'guix-list-time))
|
||||
|
||||
(defun guix-list-get-file-name (file-name &optional _)
|
||||
"Return FILE-NAME button specification for `tabulated-list-entries'."
|
||||
(list file-name
|
||||
'face 'guix-list-file-name
|
||||
'action (lambda (btn) (find-file (button-label btn)))
|
||||
'follow-link t
|
||||
'help-echo "Find file"))
|
||||
|
||||
(defun guix-list-get-url (url &optional _)
|
||||
"Return URL button specification for `tabulated-list-entries'."
|
||||
(list url
|
||||
'face 'guix-list-url
|
||||
'action (lambda (btn) (browse-url (button-label btn)))
|
||||
'follow-link t
|
||||
'help-echo "Browse URL"))
|
||||
|
||||
|
||||
;;; 'List' lines
|
||||
|
||||
(defun guix-list-current-id ()
|
||||
"Return ID of the entry at point."
|
||||
(or (tabulated-list-get-id)
|
||||
(user-error "No entry here")))
|
||||
|
||||
(defun guix-list-current-entry ()
|
||||
"Return entry at point."
|
||||
(guix-entry-by-id (guix-list-current-id)
|
||||
(guix-buffer-current-entries)))
|
||||
|
||||
(defun guix-list-for-each-line (fun &rest args)
|
||||
"Call FUN with ARGS for each entry line."
|
||||
(or (derived-mode-p 'guix-list-mode)
|
||||
(error "The current buffer is not in Guix List mode"))
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(apply fun args)
|
||||
(forward-line))))
|
||||
|
||||
(defun guix-list-fold-lines (fun init)
|
||||
"Fold over entry lines in the current list buffer.
|
||||
Call FUN with RESULT as argument for each line, using INIT as
|
||||
the initial value of RESULT. Return the final result."
|
||||
(let ((res init))
|
||||
(guix-list-for-each-line
|
||||
(lambda () (setq res (funcall fun res))))
|
||||
res))
|
||||
|
||||
|
||||
;;; Marking and sorting
|
||||
|
||||
(defvar-local guix-list-marked nil
|
||||
"List of the marked entries.
|
||||
Each element of the list has a form:
|
||||
|
||||
(ID MARK-NAME . ARGS)
|
||||
|
||||
ID is an entry ID.
|
||||
MARK-NAME is a symbol from `guix-list-marks'.
|
||||
ARGS is a list of additional values.")
|
||||
|
||||
(defvar-local guix-list-marks nil
|
||||
"Alist of available mark names and mark characters.")
|
||||
|
||||
(defvar guix-list-default-marks
|
||||
'((empty . ?\s)
|
||||
(general . ?*))
|
||||
"Alist of default mark names and mark characters.")
|
||||
|
||||
(defun guix-list-marks (entry-type)
|
||||
"Return alist of available marks for ENTRY-TYPE."
|
||||
(append guix-list-default-marks
|
||||
(guix-list-additional-marks entry-type)))
|
||||
|
||||
(defun guix-list-get-mark (name)
|
||||
"Return mark character by its NAME."
|
||||
(or (guix-assq-value guix-list-marks name)
|
||||
(error "Mark '%S' not found" name)))
|
||||
|
||||
(defun guix-list-get-mark-string (name)
|
||||
"Return mark string by its NAME."
|
||||
(string (guix-list-get-mark name)))
|
||||
|
||||
(defun guix-list-current-mark ()
|
||||
"Return mark character of the current line."
|
||||
(char-after (line-beginning-position)))
|
||||
|
||||
(defun guix-list-get-marked (&rest mark-names)
|
||||
"Return list of specs of entries marked with any mark from MARK-NAMES.
|
||||
Entry specs are elements from `guix-list-marked' list.
|
||||
If MARK-NAMES are not specified, use all marks from
|
||||
`guix-list-marks' except the `empty' one."
|
||||
(or mark-names
|
||||
(setq mark-names
|
||||
(delq 'empty
|
||||
(mapcar #'car guix-list-marks))))
|
||||
(cl-remove-if-not (lambda (assoc)
|
||||
(memq (cadr assoc) mark-names))
|
||||
guix-list-marked))
|
||||
|
||||
(defun guix-list-get-marked-args (mark-name)
|
||||
"Return list of (ID . ARGS) elements from lines marked with MARK-NAME.
|
||||
See `guix-list-marked' for the meaning of ARGS."
|
||||
(mapcar (lambda (spec)
|
||||
(let ((id (car spec))
|
||||
(args (cddr spec)))
|
||||
(cons id args)))
|
||||
(guix-list-get-marked mark-name)))
|
||||
|
||||
(defun guix-list-get-marked-id-list (&rest mark-names)
|
||||
"Return list of IDs of entries marked with any mark from MARK-NAMES.
|
||||
See `guix-list-get-marked' for details."
|
||||
(mapcar #'car (apply #'guix-list-get-marked mark-names)))
|
||||
|
||||
(defun guix-list--mark (mark-name &optional advance &rest args)
|
||||
"Put a mark on the current line.
|
||||
Also add the current entry to `guix-list-marked' using its ID and ARGS.
|
||||
MARK-NAME is a symbol from `guix-list-marks'.
|
||||
If ADVANCE is non-nil, move forward by one line after marking."
|
||||
(let ((id (guix-list-current-id)))
|
||||
(if (eq mark-name 'empty)
|
||||
(setq guix-list-marked (assq-delete-all id guix-list-marked))
|
||||
(let ((assoc (assq id guix-list-marked))
|
||||
(val (cons mark-name args)))
|
||||
(if assoc
|
||||
(setcdr assoc val)
|
||||
(push (cons id val) guix-list-marked)))))
|
||||
(tabulated-list-put-tag (guix-list-get-mark-string mark-name)
|
||||
advance))
|
||||
|
||||
(defun guix-list-mark (&optional arg)
|
||||
"Mark the current line and move to the next line.
|
||||
With ARG, mark all lines."
|
||||
(interactive "P")
|
||||
(if arg
|
||||
(guix-list-mark-all)
|
||||
(guix-list--mark 'general t)))
|
||||
|
||||
(defun guix-list-mark-all (&optional mark-name)
|
||||
"Mark all lines with MARK-NAME mark.
|
||||
MARK-NAME is a symbol from `guix-list-marks'.
|
||||
Interactively, put a general mark on all lines."
|
||||
(interactive)
|
||||
(or mark-name (setq mark-name 'general))
|
||||
(guix-list-for-each-line #'guix-list--mark mark-name))
|
||||
|
||||
(defun guix-list-unmark (&optional arg)
|
||||
"Unmark the current line and move to the next line.
|
||||
With ARG, unmark all lines."
|
||||
(interactive "P")
|
||||
(if arg
|
||||
(guix-list-unmark-all)
|
||||
(guix-list--mark 'empty t)))
|
||||
|
||||
(defun guix-list-unmark-backward ()
|
||||
"Move up one line and unmark it."
|
||||
(interactive)
|
||||
(forward-line -1)
|
||||
(guix-list--mark 'empty))
|
||||
|
||||
(defun guix-list-unmark-all ()
|
||||
"Unmark all lines."
|
||||
(interactive)
|
||||
(guix-list-mark-all 'empty))
|
||||
|
||||
(defun guix-list-restore-marks ()
|
||||
"Put marks according to `guix-list-marked'."
|
||||
(guix-list-for-each-line
|
||||
(lambda ()
|
||||
(let ((mark-name (car (guix-assq-value guix-list-marked
|
||||
(guix-list-current-id)))))
|
||||
(tabulated-list-put-tag
|
||||
(guix-list-get-mark-string (or mark-name 'empty)))))))
|
||||
|
||||
(defun guix-list-sort (&optional n)
|
||||
"Sort guix list entries by the column at point.
|
||||
With a numeric prefix argument N, sort the Nth column.
|
||||
Same as `tabulated-list-sort', but also restore marks after sorting."
|
||||
(interactive "P")
|
||||
(tabulated-list-sort n)
|
||||
(guix-list-restore-marks))
|
||||
|
||||
|
||||
;;; Major mode and interface definer
|
||||
|
||||
(defvar guix-list-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent
|
||||
map (make-composed-keymap guix-buffer-map
|
||||
tabulated-list-mode-map))
|
||||
(define-key map (kbd "RET") 'guix-list-describe)
|
||||
(define-key map (kbd "i") 'guix-list-describe)
|
||||
(define-key map (kbd "m") 'guix-list-mark)
|
||||
(define-key map (kbd "*") 'guix-list-mark)
|
||||
(define-key map (kbd "u") 'guix-list-unmark)
|
||||
(define-key map (kbd "DEL") 'guix-list-unmark-backward)
|
||||
(define-key map [remap tabulated-list-sort] 'guix-list-sort)
|
||||
map)
|
||||
"Keymap for `guix-list-mode' buffers.")
|
||||
|
||||
(define-derived-mode guix-list-mode tabulated-list-mode "Guix-List"
|
||||
"Parent mode for displaying data in 'list' form.")
|
||||
|
||||
(defun guix-list-mode-initialize (entry-type)
|
||||
"Set up the current 'list' buffer for displaying ENTRY-TYPE entries."
|
||||
(setq tabulated-list-padding 2
|
||||
tabulated-list-format (guix-list-tabulated-format entry-type)
|
||||
tabulated-list-sort-key (guix-list-tabulated-sort-key entry-type))
|
||||
(setq-local guix-list-marks (guix-list-marks entry-type))
|
||||
(tabulated-list-init-header))
|
||||
|
||||
(defmacro guix-list-define-interface (entry-type &rest args)
|
||||
"Define 'list' interface for displaying ENTRY-TYPE entries.
|
||||
Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
|
||||
|
||||
Required keywords:
|
||||
|
||||
- `:format' - default value of the generated
|
||||
`guix-ENTRY-TYPE-list-format' variable.
|
||||
|
||||
Optional keywords:
|
||||
|
||||
- `:sort-key' - default value of the generated
|
||||
`guix-ENTRY-TYPE-list-sort-key' variable.
|
||||
|
||||
- `:describe-function' - default value of the generated
|
||||
`guix-ENTRY-TYPE-describe-function' variable.
|
||||
|
||||
- `:list-single?' - default value of the generated
|
||||
`guix-ENTRY-TYPE-list-single' variable.
|
||||
|
||||
- `:marks' - default value of the generated
|
||||
`guix-ENTRY-TYPE-list-marks' variable.
|
||||
|
||||
The rest keyword arguments are passed to
|
||||
`guix-buffer-define-interface' macro."
|
||||
(declare (indent 1))
|
||||
(let* ((entry-type-str (symbol-name entry-type))
|
||||
(prefix (concat "guix-" entry-type-str "-list"))
|
||||
(group (intern prefix))
|
||||
(describe-var (intern (concat prefix "-describe-function")))
|
||||
(describe-count-var (intern (concat prefix
|
||||
"-describe-warning-count")))
|
||||
(format-var (intern (concat prefix "-format")))
|
||||
(sort-key-var (intern (concat prefix "-sort-key")))
|
||||
(list-single-var (intern (concat prefix "-single")))
|
||||
(marks-var (intern (concat prefix "-marks"))))
|
||||
(guix-keyword-args-let args
|
||||
((show-entries-val :show-entries-function)
|
||||
(describe-val :describe-function)
|
||||
(describe-count-val :describe-count 10)
|
||||
(format-val :format)
|
||||
(sort-key-val :sort-key)
|
||||
(list-single-val :list-single?)
|
||||
(marks-val :marks))
|
||||
`(progn
|
||||
(defcustom ,format-var ,format-val
|
||||
,(format "\
|
||||
List of format values of the displayed columns.
|
||||
Each element of the list has a form:
|
||||
|
||||
(PARAM VALUE-FUN WIDTH SORT . PROPS)
|
||||
|
||||
PARAM is a name of '%s' entry parameter.
|
||||
|
||||
VALUE-FUN may be either nil or a function returning a value that
|
||||
will be inserted. The function is called with 2 arguments: the
|
||||
first one is the value of the parameter; the second one is an
|
||||
entry (alist of parameter names and values).
|
||||
|
||||
For the meaning of WIDTH, SORT and PROPS, see
|
||||
`tabulated-list-format'."
|
||||
entry-type-str)
|
||||
:type 'sexp
|
||||
:group ',group)
|
||||
|
||||
(defcustom ,sort-key-var ,sort-key-val
|
||||
,(format "\
|
||||
Default sort key for 'list' buffer with '%s' entries.
|
||||
Should be nil (no sort) or have a form:
|
||||
|
||||
(PARAM . FLIP)
|
||||
|
||||
PARAM is the name of '%s' entry parameter. For the meaning of
|
||||
FLIP, see `tabulated-list-sort-key'."
|
||||
entry-type-str entry-type-str)
|
||||
:type '(choice (const :tag "No sort" nil)
|
||||
(cons symbol boolean))
|
||||
:group ',group)
|
||||
|
||||
(defvar ,marks-var ,marks-val
|
||||
,(format "\
|
||||
Alist of additional marks for 'list' buffer with '%s' entries.
|
||||
Marks from this list are used along with `guix-list-default-marks'."
|
||||
entry-type-str))
|
||||
|
||||
(defcustom ,list-single-var ,list-single-val
|
||||
,(format "\
|
||||
If non-nil, list '%s' entry even if it is the only matching result.
|
||||
If nil, show a single '%s' entry in the 'info' buffer."
|
||||
entry-type-str entry-type-str)
|
||||
:type 'boolean
|
||||
:group ',group)
|
||||
|
||||
(defcustom ,describe-count-var ,describe-count-val
|
||||
,(format "\
|
||||
The maximum number of '%s' entries to describe without a warning.
|
||||
If a user wants to describe more than this number of marked
|
||||
entries, he will be prompted for confirmation.
|
||||
See also `guix-list-describe'."
|
||||
entry-type-str)
|
||||
:type 'integer
|
||||
:group ',group)
|
||||
|
||||
(defvar ,describe-var ,describe-val
|
||||
,(format "Function used to describe '%s' entries."
|
||||
entry-type-str))
|
||||
|
||||
(guix-alist-put!
|
||||
'((describe . ,describe-var)
|
||||
(describe-count . ,describe-count-var)
|
||||
(format . ,format-var)
|
||||
(sort-key . ,sort-key-var)
|
||||
(list-single . ,list-single-var)
|
||||
(marks . ,marks-var))
|
||||
'guix-list-data ',entry-type)
|
||||
|
||||
,(if show-entries-val
|
||||
`(guix-buffer-define-interface list ,entry-type
|
||||
:show-entries-function ,show-entries-val
|
||||
,@%foreign-args)
|
||||
|
||||
(let ((insert-fun (intern (concat prefix "-insert-entries")))
|
||||
(mode-init-fun (intern (concat prefix "-mode-initialize"))))
|
||||
`(progn
|
||||
(defun ,insert-fun (entries)
|
||||
,(format "\
|
||||
Print '%s' ENTRIES in the current 'list' buffer."
|
||||
entry-type-str)
|
||||
(guix-list-insert-entries entries ',entry-type))
|
||||
|
||||
(defun ,mode-init-fun ()
|
||||
,(format "\
|
||||
Set up the current 'list' buffer for displaying '%s' entries."
|
||||
entry-type-str)
|
||||
(guix-list-mode-initialize ',entry-type))
|
||||
|
||||
(guix-buffer-define-interface list ,entry-type
|
||||
:insert-entries-function ',insert-fun
|
||||
:mode-init-function ',mode-init-fun
|
||||
,@%foreign-args))))))))
|
||||
|
||||
|
||||
(defvar guix-list-font-lock-keywords
|
||||
(eval-when-compile
|
||||
`((,(rx "(" (group "guix-list-define-interface")
|
||||
symbol-end)
|
||||
. 1))))
|
||||
|
||||
(font-lock-add-keywords 'emacs-lisp-mode guix-list-font-lock-keywords)
|
||||
|
||||
(provide 'guix-list)
|
||||
|
||||
;;; guix-list.el ends here
|
||||
@@ -1,79 +0,0 @@
|
||||
;;; guix-location.el --- Package locations
|
||||
|
||||
;; Copyright © 2016 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public Location as published by
|
||||
;; the Free Software Foundation, either version 3 of the Location, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public Location for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public Location
|
||||
;; along with this program. If not, see <http://www.gnu.org/locations/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides the code to work with locations of Guix packages.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'guix-backend)
|
||||
(require 'guix-read)
|
||||
(require 'guix-guile)
|
||||
|
||||
(defun guix-package-location (id-or-name)
|
||||
"Return location of a package with ID-OR-NAME.
|
||||
For the meaning of location, see `guix-find-location'."
|
||||
(guix-eval-read (guix-make-guile-expression
|
||||
'package-location-string id-or-name)))
|
||||
|
||||
;;;###autoload
|
||||
(defun guix-find-location (location &optional directory)
|
||||
"Go to LOCATION of a package.
|
||||
LOCATION is a string of the form:
|
||||
|
||||
\"FILE:LINE:COLUMN\"
|
||||
|
||||
If FILE is relative, it is considered to be relative to
|
||||
DIRECTORY (`guix-directory' by default).
|
||||
|
||||
Interactively, prompt for LOCATION. With prefix argument, prompt
|
||||
for DIRECTORY as well."
|
||||
(interactive
|
||||
(list (guix-read-package-location)
|
||||
(guix-read-directory)))
|
||||
(cl-multiple-value-bind (file line column)
|
||||
(split-string location ":")
|
||||
(find-file (expand-file-name file (or directory guix-directory)))
|
||||
(when (and line column)
|
||||
(let ((line (string-to-number line))
|
||||
(column (string-to-number column)))
|
||||
(goto-char (point-min))
|
||||
(forward-line (- line 1))
|
||||
(move-to-column column)
|
||||
(recenter 1)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun guix-edit (id-or-name &optional directory)
|
||||
"Edit (go to location of) package with ID-OR-NAME.
|
||||
See `guix-find-location' for the meaning of package location and
|
||||
DIRECTORY.
|
||||
Interactively, with prefix argument, prompt for DIRECTORY."
|
||||
(interactive
|
||||
(list (guix-read-package-name)
|
||||
(guix-read-directory)))
|
||||
(let ((loc (guix-package-location id-or-name)))
|
||||
(if loc
|
||||
(guix-find-location loc directory)
|
||||
(message "Couldn't find package location."))))
|
||||
|
||||
(provide 'guix-location)
|
||||
|
||||
;;; guix-location.el ends here
|
||||
-1163
File diff suppressed because it is too large
Load Diff
@@ -1,247 +0,0 @@
|
||||
;;; guix-messages.el --- Minibuffer messages
|
||||
|
||||
;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides `guix-result-message' function used to show a
|
||||
;; minibuffer message after displaying packages/generations in a
|
||||
;; list/info buffer.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'guix-utils)
|
||||
|
||||
(defvar guix-messages
|
||||
`((package
|
||||
(id
|
||||
,(lambda (_ entries ids)
|
||||
(guix-message-packages-by-id entries 'package ids)))
|
||||
(name
|
||||
,(lambda (_ entries names)
|
||||
(guix-message-packages-by-name entries 'package names)))
|
||||
(license
|
||||
,(lambda (_ entries licenses)
|
||||
(apply #'guix-message-packages-by-license
|
||||
entries 'package licenses)))
|
||||
(location
|
||||
,(lambda (_ entries locations)
|
||||
(apply #'guix-message-packages-by-location
|
||||
entries 'package locations)))
|
||||
(from-file
|
||||
(0 "No package in file '%s'." val)
|
||||
(1 "Package from file '%s'." val))
|
||||
(regexp
|
||||
(0 "No packages matching '%s'." val)
|
||||
(1 "A single package matching '%s'." val)
|
||||
(many "%d packages matching '%s'." count val))
|
||||
(all-available
|
||||
(0 "No packages are available for some reason.")
|
||||
(1 "A single available package (that's strange).")
|
||||
(many "%d available packages." count))
|
||||
(newest-available
|
||||
(0 "No packages are available for some reason.")
|
||||
(1 "A single newest available package (that's strange).")
|
||||
(many "%d newest available packages." count))
|
||||
(installed
|
||||
(0 "No packages installed in profile '%s'." profile)
|
||||
(1 "A single package installed in profile '%s'." profile)
|
||||
(many "%d packages installed in profile '%s'." count profile))
|
||||
(obsolete
|
||||
(0 "No obsolete packages in profile '%s'." profile)
|
||||
(1 "A single obsolete package in profile '%s'." profile)
|
||||
(many "%d obsolete packages in profile '%s'." count profile)))
|
||||
|
||||
(output
|
||||
(id
|
||||
,(lambda (_ entries ids)
|
||||
(guix-message-packages-by-id entries 'output ids)))
|
||||
(name
|
||||
,(lambda (_ entries names)
|
||||
(guix-message-packages-by-name entries 'output names)))
|
||||
(license
|
||||
,(lambda (_ entries licenses)
|
||||
(apply #'guix-message-packages-by-license
|
||||
entries 'output licenses)))
|
||||
(location
|
||||
,(lambda (_ entries locations)
|
||||
(apply #'guix-message-packages-by-location
|
||||
entries 'output locations)))
|
||||
(from-file
|
||||
(0 "No package in file '%s'." val)
|
||||
(1 "Package from file '%s'." val)
|
||||
(many "Package outputs from file '%s'." val))
|
||||
(regexp
|
||||
(0 "No package outputs matching '%s'." val)
|
||||
(1 "A single package output matching '%s'." val)
|
||||
(many "%d package outputs matching '%s'." count val))
|
||||
(all-available
|
||||
(0 "No package outputs are available for some reason.")
|
||||
(1 "A single available package output (that's strange).")
|
||||
(many "%d available package outputs." count))
|
||||
(newest-available
|
||||
(0 "No package outputs are available for some reason.")
|
||||
(1 "A single newest available package output (that's strange).")
|
||||
(many "%d newest available package outputs." count))
|
||||
(installed
|
||||
(0 "No package outputs installed in profile '%s'." profile)
|
||||
(1 "A single package output installed in profile '%s'." profile)
|
||||
(many "%d package outputs installed in profile '%s'." count profile))
|
||||
(obsolete
|
||||
(0 "No obsolete package outputs in profile '%s'." profile)
|
||||
(1 "A single obsolete package output in profile '%s'." profile)
|
||||
(many "%d obsolete package outputs in profile '%s'." count profile))
|
||||
(profile-diff
|
||||
guix-message-outputs-by-diff))
|
||||
|
||||
(generation
|
||||
(id
|
||||
(0 "Generations not found.")
|
||||
(1 "")
|
||||
(many "%d generations." count))
|
||||
(last
|
||||
(0 "No generations in profile '%s'." profile)
|
||||
(1 "The last generation of profile '%s'." profile)
|
||||
(many "%d last generations of profile '%s'." count profile))
|
||||
(all
|
||||
(0 "No generations in profile '%s'." profile)
|
||||
(1 "A single generation available in profile '%s'." profile)
|
||||
(many "%d generations available in profile '%s'." count profile))
|
||||
(time
|
||||
guix-message-generations-by-time))))
|
||||
|
||||
(defun guix-message-string-name (name)
|
||||
"Return a quoted name string."
|
||||
(concat "'" name "'"))
|
||||
|
||||
(defun guix-message-string-entry-type (entry-type &optional plural)
|
||||
"Return a string denoting an ENTRY-TYPE."
|
||||
(cl-ecase entry-type
|
||||
(package
|
||||
(if plural "packages" "package"))
|
||||
(output
|
||||
(if plural "package outputs" "package output"))
|
||||
(generation
|
||||
(if plural "generations" "generation"))))
|
||||
|
||||
(defun guix-message-string-entries (count entry-type)
|
||||
"Return a string denoting the COUNT of ENTRY-TYPE entries."
|
||||
(cl-case count
|
||||
(0 (concat "No "
|
||||
(guix-message-string-entry-type
|
||||
entry-type 'plural)))
|
||||
(1 (concat "A single "
|
||||
(guix-message-string-entry-type
|
||||
entry-type)))
|
||||
(t (format "%d %s"
|
||||
count
|
||||
(guix-message-string-entry-type
|
||||
entry-type 'plural)))))
|
||||
|
||||
(defun guix-message-packages-by-id (entries entry-type ids)
|
||||
"Display a message for packages or outputs searched by IDS."
|
||||
(let* ((count (length entries))
|
||||
(str-beg (guix-message-string-entries count entry-type))
|
||||
(str-end (if (> count 1)
|
||||
(concat "with the following IDs: "
|
||||
(mapconcat #'guix-get-string ids ", "))
|
||||
(concat "with ID " (guix-get-string (car ids))))))
|
||||
(if (zerop count)
|
||||
(message "%s %s.
|
||||
Most likely, Guix REPL was restarted, so IDs are not actual
|
||||
anymore, because they live only during the REPL process.
|
||||
Try \"M-x guix-search-by-name\"."
|
||||
str-beg str-end)
|
||||
(message "%s %s." str-beg str-end))))
|
||||
|
||||
(defun guix-message-packages-by-name (entries entry-type names)
|
||||
"Display a message for packages or outputs searched by NAMES."
|
||||
(let* ((count (length entries))
|
||||
(str-beg (guix-message-string-entries count entry-type))
|
||||
(str-end (if (cdr names)
|
||||
(concat "matching the following names: "
|
||||
(mapconcat #'guix-message-string-name
|
||||
names ", "))
|
||||
(concat "with name "
|
||||
(guix-message-string-name (car names))))))
|
||||
(message "%s %s." str-beg str-end)))
|
||||
|
||||
(defun guix-message-packages-by-license (entries entry-type license)
|
||||
"Display a message for packages or outputs searched by LICENSE."
|
||||
(let* ((count (length entries))
|
||||
(str-beg (guix-message-string-entries count entry-type))
|
||||
(str-end (format "with license '%s'" license)))
|
||||
(message "%s %s." str-beg str-end)))
|
||||
|
||||
(defun guix-message-packages-by-location (entries entry-type location)
|
||||
"Display a message for packages or outputs searched by LOCATION."
|
||||
(let* ((count (length entries))
|
||||
(str-beg (guix-message-string-entries count entry-type))
|
||||
(str-end (format "placed in '%s'" location)))
|
||||
(message "%s %s." str-beg str-end)))
|
||||
|
||||
(defun guix-message-generations-by-time (profile entries times)
|
||||
"Display a message for generations searched by TIMES."
|
||||
(let* ((count (length entries))
|
||||
(str-beg (guix-message-string-entries count 'generation))
|
||||
(time-beg (guix-get-time-string (car times)))
|
||||
(time-end (guix-get-time-string (cadr times))))
|
||||
(message (concat "%s of profile '%s'\n"
|
||||
"matching time period '%s' - '%s'.")
|
||||
str-beg profile time-beg time-end)))
|
||||
|
||||
(defun guix-message-outputs-by-diff (_ entries profiles)
|
||||
"Display a message for outputs searched by PROFILES difference."
|
||||
(let* ((count (length entries))
|
||||
(str-beg (guix-message-string-entries count 'output))
|
||||
(profile1 (car profiles))
|
||||
(profile2 (cadr profiles)))
|
||||
(cl-multiple-value-bind (new old str-action)
|
||||
(if (string-lessp profile2 profile1)
|
||||
(list profile1 profile2 "added to")
|
||||
(list profile2 profile1 "removed from"))
|
||||
(message "%s %s profile '%s' comparing with profile '%s'."
|
||||
str-beg str-action new old))))
|
||||
|
||||
(defun guix-result-message (profile entries entry-type
|
||||
search-type search-vals)
|
||||
"Display an appropriate message after displaying ENTRIES."
|
||||
(let* ((type-spec (guix-assq-value guix-messages
|
||||
(if (eq entry-type 'system-generation)
|
||||
'generation
|
||||
entry-type)
|
||||
search-type))
|
||||
(fun-or-count-spec (car type-spec)))
|
||||
(if (functionp fun-or-count-spec)
|
||||
(funcall fun-or-count-spec profile entries search-vals)
|
||||
(let* ((count (length entries))
|
||||
(count-key (if (> count 1) 'many count))
|
||||
(msg-spec (guix-assq-value type-spec count-key))
|
||||
(msg (car msg-spec))
|
||||
(args (cdr msg-spec)))
|
||||
(mapc (lambda (subst)
|
||||
(setq args (cl-substitute (cdr subst) (car subst) args)))
|
||||
`((count . ,count)
|
||||
(val . ,(car search-vals))
|
||||
(profile . ,profile)))
|
||||
(apply #'message msg args)))))
|
||||
|
||||
(provide 'guix-messages)
|
||||
|
||||
;;; guix-messages.el ends here
|
||||
@@ -1,370 +0,0 @@
|
||||
;;; guix-pcomplete.el --- Functions for completing guix commands -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright © 2015 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides completions for "guix" command that may be used in
|
||||
;; `shell', `eshell' and wherever `pcomplete' works.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'pcomplete)
|
||||
(require 'pcmpl-unix)
|
||||
(require 'cl-lib)
|
||||
(require 'guix-utils)
|
||||
(require 'guix-help-vars)
|
||||
|
||||
|
||||
;;; Interacting with guix
|
||||
|
||||
(defcustom guix-pcomplete-guix-program (executable-find "guix")
|
||||
"Name of the 'guix' program.
|
||||
It is used to find guix commands, options, packages, etc."
|
||||
:type 'file
|
||||
:group 'pcomplete
|
||||
:group 'guix)
|
||||
|
||||
(defun guix-pcomplete-run-guix (&rest args)
|
||||
"Run `guix-pcomplete-guix-program' with ARGS.
|
||||
Insert the output to the current buffer."
|
||||
(apply #'call-process
|
||||
guix-pcomplete-guix-program nil t nil args))
|
||||
|
||||
(defun guix-pcomplete-run-guix-and-search (regexp &optional group
|
||||
&rest args)
|
||||
"Run `guix-pcomplete-guix-program' with ARGS and search for matches.
|
||||
Return a list of strings matching REGEXP.
|
||||
GROUP specifies a parenthesized expression used in REGEXP."
|
||||
(with-temp-buffer
|
||||
(apply #'guix-pcomplete-run-guix args)
|
||||
(let (result)
|
||||
(guix-while-search regexp
|
||||
(push (match-string-no-properties group) result))
|
||||
(nreverse result))))
|
||||
|
||||
(defmacro guix-pcomplete-define-options-finder (name docstring regexp
|
||||
&optional filter)
|
||||
"Define function NAME to receive guix options and commands.
|
||||
|
||||
The defined function takes an optional COMMAND argument. This
|
||||
function will run 'guix COMMAND --help' (or 'guix --help' if
|
||||
COMMAND is nil) using `guix-pcomplete-run-guix-and-search' and
|
||||
return its result.
|
||||
|
||||
If FILTER is specified, it should be a function. The result is
|
||||
passed to this FILTER as argument and the result value of this
|
||||
function call is returned."
|
||||
(declare (doc-string 2) (indent 1))
|
||||
`(guix-memoized-defun ,name (&optional command)
|
||||
,docstring
|
||||
(let* ((args '("--help"))
|
||||
(args (if command (cons command args) args))
|
||||
(res (apply #'guix-pcomplete-run-guix-and-search
|
||||
,regexp guix-help-parse-regexp-group args)))
|
||||
,(if filter
|
||||
`(funcall ,filter res)
|
||||
'res))))
|
||||
|
||||
(guix-pcomplete-define-options-finder guix-pcomplete-commands
|
||||
"If COMMAND is nil, return a list of available guix commands.
|
||||
If COMMAND is non-nil (it should be a string), return available
|
||||
subcommands, actions, etc. for this guix COMMAND."
|
||||
guix-help-parse-command-regexp)
|
||||
|
||||
(guix-pcomplete-define-options-finder guix-pcomplete-long-options
|
||||
"Return a list of available long options for guix COMMAND."
|
||||
guix-help-parse-long-option-regexp)
|
||||
|
||||
(guix-pcomplete-define-options-finder guix-pcomplete-short-options
|
||||
"Return a string with available short options for guix COMMAND."
|
||||
guix-help-parse-short-option-regexp
|
||||
(lambda (list)
|
||||
(guix-concat-strings list "")))
|
||||
|
||||
(guix-memoized-defun guix-pcomplete-all-packages ()
|
||||
"Return a list of all available Guix packages."
|
||||
(guix-pcomplete-run-guix-and-search
|
||||
guix-help-parse-package-regexp
|
||||
guix-help-parse-regexp-group
|
||||
"package" "--list-available"))
|
||||
|
||||
(guix-memoized-defun guix-pcomplete-installed-packages (&optional profile)
|
||||
"Return a list of Guix packages installed in PROFILE."
|
||||
(let* ((args (and profile
|
||||
(list (concat "--profile=" profile))))
|
||||
(args (append '("package" "--list-installed") args)))
|
||||
(apply #'guix-pcomplete-run-guix-and-search
|
||||
guix-help-parse-package-regexp
|
||||
guix-help-parse-regexp-group
|
||||
args)))
|
||||
|
||||
(guix-memoized-defun guix-pcomplete-lint-checkers ()
|
||||
"Return a list of all available lint checkers."
|
||||
(guix-pcomplete-run-guix-and-search
|
||||
guix-help-parse-list-regexp
|
||||
guix-help-parse-regexp-group
|
||||
"lint" "--list-checkers"))
|
||||
|
||||
(guix-memoized-defun guix-pcomplete-graph-types ()
|
||||
"Return a list of all available graph types."
|
||||
(guix-pcomplete-run-guix-and-search
|
||||
guix-help-parse-list-regexp
|
||||
guix-help-parse-regexp-group
|
||||
"graph" "--list-types"))
|
||||
|
||||
(guix-memoized-defun guix-pcomplete-refresh-updaters ()
|
||||
"Return a list of all available refresh updater types."
|
||||
(guix-pcomplete-run-guix-and-search
|
||||
guix-help-parse-list-regexp
|
||||
guix-help-parse-regexp-group
|
||||
"refresh" "--list-updaters"))
|
||||
|
||||
|
||||
;;; Completing
|
||||
|
||||
(defvar guix-pcomplete-option-regexp (rx string-start "-")
|
||||
"Regexp to match an option.")
|
||||
|
||||
(defvar guix-pcomplete-long-option-regexp (rx string-start "--")
|
||||
"Regexp to match a long option.")
|
||||
|
||||
(defvar guix-pcomplete-long-option-with-arg-regexp
|
||||
(rx string-start
|
||||
(group "--" (one-or-more any)) "="
|
||||
(group (zero-or-more any)))
|
||||
"Regexp to match a long option with its argument.
|
||||
The first parenthesized group defines the option and the second
|
||||
group - the argument.")
|
||||
|
||||
(defvar guix-pcomplete-short-option-with-arg-regexp
|
||||
(rx string-start
|
||||
(group "-" (not (any "-")))
|
||||
(group (zero-or-more any)))
|
||||
"Regexp to match a short option with its argument.
|
||||
The first parenthesized group defines the option and the second
|
||||
group - the argument.")
|
||||
|
||||
(defun guix-pcomplete-match-option ()
|
||||
"Return non-nil, if the current argument is an option."
|
||||
(pcomplete-match guix-pcomplete-option-regexp 0))
|
||||
|
||||
(defun guix-pcomplete-match-long-option ()
|
||||
"Return non-nil, if the current argument is a long option."
|
||||
(pcomplete-match guix-pcomplete-long-option-regexp 0))
|
||||
|
||||
(defun guix-pcomplete-match-long-option-with-arg ()
|
||||
"Return non-nil, if the current argument is a long option with value."
|
||||
(pcomplete-match guix-pcomplete-long-option-with-arg-regexp 0))
|
||||
|
||||
(defun guix-pcomplete-match-short-option-with-arg ()
|
||||
"Return non-nil, if the current argument is a short option with value."
|
||||
(pcomplete-match guix-pcomplete-short-option-with-arg-regexp 0))
|
||||
|
||||
(defun guix-pcomplete-long-option-arg (option args)
|
||||
"Return a long OPTION's argument from a list of arguments ARGS."
|
||||
(let* ((re (concat "\\`" option "=\\(.*\\)"))
|
||||
(args (cl-member-if (lambda (arg)
|
||||
(string-match re arg))
|
||||
args))
|
||||
(cur (car args)))
|
||||
(when cur
|
||||
(match-string-no-properties 1 cur))))
|
||||
|
||||
(defun guix-pcomplete-short-option-arg (option args)
|
||||
"Return a short OPTION's argument from a list of arguments ARGS."
|
||||
(let* ((re (concat "\\`" option "\\(.*\\)"))
|
||||
(args (cl-member-if (lambda (arg)
|
||||
(string-match re arg))
|
||||
args))
|
||||
(cur (car args)))
|
||||
(when cur
|
||||
(let ((arg (match-string-no-properties 1 cur)))
|
||||
(if (string= "" arg)
|
||||
(cadr args) ; take the next arg
|
||||
arg)))))
|
||||
|
||||
(defun guix-pcomplete-complete-comma-args (entries)
|
||||
"Complete comma separated arguments using ENTRIES."
|
||||
(let ((index pcomplete-index))
|
||||
(while (= index pcomplete-index)
|
||||
(let* ((args (if (or (guix-pcomplete-match-long-option-with-arg)
|
||||
(guix-pcomplete-match-short-option-with-arg))
|
||||
(pcomplete-match-string 2 0)
|
||||
(pcomplete-arg 0)))
|
||||
(input (if (string-match ".*,\\(.*\\)" args)
|
||||
(match-string-no-properties 1 args)
|
||||
args)))
|
||||
(pcomplete-here* entries input)))))
|
||||
|
||||
(defun guix-pcomplete-complete-command-arg (command)
|
||||
"Complete argument for guix COMMAND."
|
||||
(cond
|
||||
((member command
|
||||
'("archive" "build" "challenge" "edit" "environment"
|
||||
"graph" "lint" "refresh" "size"))
|
||||
(while t
|
||||
(pcomplete-here (guix-pcomplete-all-packages))))
|
||||
(t (pcomplete-here* (pcomplete-entries)))))
|
||||
|
||||
(defun guix-pcomplete-complete-option-arg (command option &optional input)
|
||||
"Complete argument for COMMAND's OPTION.
|
||||
INPUT is the current partially completed string."
|
||||
(cl-flet ((option? (short long)
|
||||
(or (string= option short)
|
||||
(string= option long)))
|
||||
(command? (&rest commands)
|
||||
(member command commands))
|
||||
(complete (entries)
|
||||
(pcomplete-here entries input nil t))
|
||||
(complete* (entries)
|
||||
(pcomplete-here* entries input t)))
|
||||
(cond
|
||||
((option? "-L" "--load-path")
|
||||
(complete* (pcomplete-dirs)))
|
||||
((string= "--key-download" option)
|
||||
(complete* guix-help-key-policies))
|
||||
|
||||
((command? "package")
|
||||
(cond
|
||||
;; For '--install[=]' and '--remove[=]', try to complete a package
|
||||
;; name (INPUT) after the "=" sign, and then the rest packages
|
||||
;; separated with spaces.
|
||||
((option? "-i" "--install")
|
||||
(complete (guix-pcomplete-all-packages))
|
||||
(while (not (guix-pcomplete-match-option))
|
||||
(pcomplete-here (guix-pcomplete-all-packages))))
|
||||
((option? "-r" "--remove")
|
||||
(let* ((profile (or (guix-pcomplete-short-option-arg
|
||||
"-p" pcomplete-args)
|
||||
(guix-pcomplete-long-option-arg
|
||||
"--profile" pcomplete-args)))
|
||||
(profile (and profile (expand-file-name profile))))
|
||||
(complete (guix-pcomplete-installed-packages profile))
|
||||
(while (not (guix-pcomplete-match-option))
|
||||
(pcomplete-here (guix-pcomplete-installed-packages profile)))))
|
||||
((string= "--show" option)
|
||||
(complete (guix-pcomplete-all-packages)))
|
||||
((option? "-p" "--profile")
|
||||
(complete* (pcomplete-dirs)))
|
||||
((or (option? "-f" "--install-from-file")
|
||||
(option? "-m" "--manifest"))
|
||||
(complete* (pcomplete-entries)))))
|
||||
|
||||
((and (command? "archive" "build" "size")
|
||||
(option? "-s" "--system"))
|
||||
(complete* guix-help-system-types))
|
||||
|
||||
((and (command? "build")
|
||||
(or (option? "-f" "--file")
|
||||
(option? "-r" "--root")
|
||||
(string= "--with-source" option)))
|
||||
(complete* (pcomplete-entries)))
|
||||
|
||||
((and (command? "graph")
|
||||
(option? "-t" "--type"))
|
||||
(complete* (guix-pcomplete-graph-types)))
|
||||
|
||||
((and (command? "environment")
|
||||
(option? "-l" "--load"))
|
||||
(complete* (pcomplete-entries)))
|
||||
|
||||
((and (command? "hash" "download")
|
||||
(option? "-f" "--format"))
|
||||
(complete* guix-help-hash-formats))
|
||||
|
||||
((and (command? "lint")
|
||||
(option? "-c" "--checkers"))
|
||||
(guix-pcomplete-complete-comma-args
|
||||
(guix-pcomplete-lint-checkers)))
|
||||
|
||||
((and (command? "publish")
|
||||
(option? "-u" "--user"))
|
||||
(complete* (pcmpl-unix-user-names)))
|
||||
|
||||
((command? "refresh")
|
||||
(cond
|
||||
((option? "-s" "--select")
|
||||
(complete* guix-help-refresh-subsets))
|
||||
((option? "-t" "--type")
|
||||
(guix-pcomplete-complete-comma-args
|
||||
(guix-pcomplete-refresh-updaters)))))
|
||||
|
||||
((and (command? "size")
|
||||
(option? "-m" "--map-file"))
|
||||
(complete* (pcomplete-entries))))))
|
||||
|
||||
(defun guix-pcomplete-complete-options (command)
|
||||
"Complete options (with their arguments) for guix COMMAND."
|
||||
(while (guix-pcomplete-match-option)
|
||||
(let ((index pcomplete-index))
|
||||
(if (guix-pcomplete-match-long-option)
|
||||
|
||||
;; Long options.
|
||||
(if (guix-pcomplete-match-long-option-with-arg)
|
||||
(let ((option (pcomplete-match-string 1 0))
|
||||
(arg (pcomplete-match-string 2 0)))
|
||||
(guix-pcomplete-complete-option-arg
|
||||
command option arg))
|
||||
|
||||
(pcomplete-here* (guix-pcomplete-long-options command))
|
||||
;; We support '--opt arg' style (along with '--opt=arg'),
|
||||
;; because 'guix package --install/--remove' may be used this
|
||||
;; way. So try to complete an argument after the option has
|
||||
;; been completed.
|
||||
(unless (guix-pcomplete-match-option)
|
||||
(guix-pcomplete-complete-option-arg
|
||||
command (pcomplete-arg 0 -1))))
|
||||
|
||||
;; Short options.
|
||||
(let ((arg (pcomplete-arg 0)))
|
||||
(if (> (length arg) 2)
|
||||
;; Support specifying an argument after a short option without
|
||||
;; spaces (for example, '-L/tmp/foo').
|
||||
(guix-pcomplete-complete-option-arg
|
||||
command
|
||||
(substring-no-properties arg 0 2)
|
||||
(substring-no-properties arg 2))
|
||||
(pcomplete-opt (guix-pcomplete-short-options command))
|
||||
(guix-pcomplete-complete-option-arg
|
||||
command (pcomplete-arg 0 -1)))))
|
||||
|
||||
;; If there were no completions, move to the next argument and get
|
||||
;; out if the last argument is achieved.
|
||||
(when (= index pcomplete-index)
|
||||
(if (= pcomplete-index pcomplete-last)
|
||||
(throw 'pcompleted nil)
|
||||
(pcomplete-next-arg))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun pcomplete/guix ()
|
||||
"Completion for `guix'."
|
||||
(let ((commands (guix-pcomplete-commands)))
|
||||
(pcomplete-here* (cons "--help" commands))
|
||||
(let ((command (pcomplete-arg 'first 1)))
|
||||
(when (member command commands)
|
||||
(guix-pcomplete-complete-options command)
|
||||
(let ((subcommands (guix-pcomplete-commands command)))
|
||||
(when subcommands
|
||||
(pcomplete-here* subcommands)))
|
||||
(guix-pcomplete-complete-options command)
|
||||
(guix-pcomplete-complete-command-arg command)))))
|
||||
|
||||
(provide 'guix-pcomplete)
|
||||
|
||||
;;; guix-pcomplete.el ends here
|
||||
@@ -1,48 +0,0 @@
|
||||
;;; guix-popup.el --- Popup windows library
|
||||
|
||||
;; Copyright © 2015 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides `guix-define-popup' macro which is just an alias
|
||||
;; to `magit-define-popup'. According to the manual (info
|
||||
;; "(magit-popup) Defining prefix and suffix commands") `magit-popup'
|
||||
;; library will eventually be superseded by a more general library.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'magit-popup)
|
||||
|
||||
(defalias 'guix-define-popup 'magit-define-popup)
|
||||
|
||||
(defvar guix-popup-font-lock-keywords
|
||||
(eval-when-compile
|
||||
`((,(rx "("
|
||||
(group "guix-define-popup")
|
||||
symbol-end
|
||||
(zero-or-more blank)
|
||||
(zero-or-one
|
||||
(group (one-or-more (or (syntax word) (syntax symbol))))))
|
||||
(1 font-lock-keyword-face)
|
||||
(2 font-lock-function-name-face nil t)))))
|
||||
|
||||
(font-lock-add-keywords 'emacs-lisp-mode guix-popup-font-lock-keywords)
|
||||
|
||||
(provide 'guix-popup)
|
||||
|
||||
;;; guix-popup.el ends here
|
||||
@@ -1,210 +0,0 @@
|
||||
;;; guix-prettify.el --- Prettify Guix store file names
|
||||
|
||||
;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This package provides minor-mode for prettifying Guix store file
|
||||
;; names — i.e., after enabling `guix-prettify-mode',
|
||||
;; '/gnu/store/72f54nfp6g1hz873w8z3gfcah0h4nl9p-foo-0.1' names will be
|
||||
;; replaced with '/gnu/store/…-foo-0.1' in the current buffer. There is
|
||||
;; also `global-guix-prettify-mode' for global prettifying.
|
||||
|
||||
;; To install, add the following to your emacs init file:
|
||||
;;
|
||||
;; (add-to-list 'load-path "/path/to/dir-with-guix-prettify")
|
||||
;; (autoload 'guix-prettify-mode "guix-prettify" nil t)
|
||||
;; (autoload 'global-guix-prettify-mode "guix-prettify" nil t)
|
||||
|
||||
;; If you want to enable/disable composition after "M-x font-lock-mode",
|
||||
;; use the following setting:
|
||||
;;
|
||||
;; (setq font-lock-extra-managed-props
|
||||
;; (cons 'composition font-lock-extra-managed-props))
|
||||
|
||||
;; Credits:
|
||||
;;
|
||||
;; Thanks to Ludovic Courtès for the idea of this package.
|
||||
;;
|
||||
;; Thanks to the authors of `prettify-symbols-mode' (part of Emacs 24.4)
|
||||
;; and "pretty-symbols.el" <http://github.com/drothlis/pretty-symbols>
|
||||
;; for the code. It helped to write this package.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'guix-utils)
|
||||
|
||||
(defgroup guix-prettify nil
|
||||
"Prettify Guix store file names."
|
||||
:prefix "guix-prettify-"
|
||||
:group 'guix
|
||||
:group 'font-lock
|
||||
:group 'convenience)
|
||||
|
||||
(defcustom guix-prettify-char ?…
|
||||
"Character used for prettifying."
|
||||
:type 'character
|
||||
:group 'guix-prettify)
|
||||
|
||||
(defcustom guix-prettify-decompose-force nil
|
||||
"If non-nil, remove any composition.
|
||||
|
||||
By default, after disabling `guix-prettify-mode',
|
||||
compositions (prettifying names with `guix-prettify-char') are
|
||||
removed only from strings matching `guix-prettify-regexp', so
|
||||
that compositions created by other modes are left untouched.
|
||||
|
||||
Set this variable to non-nil, if you want to remove any
|
||||
composition unconditionally (like `prettify-symbols-mode' does).
|
||||
Most likely it will do no harm and will make the process of
|
||||
disabling `guix-prettify-mode' a little faster."
|
||||
:type 'boolean
|
||||
:group 'guix-prettify)
|
||||
|
||||
(defcustom guix-prettify-regexp
|
||||
;; The following file names / URLs should be abbreviated:
|
||||
|
||||
;; /gnu/store/…-foo-0.1
|
||||
;; /nix/store/…-foo-0.1
|
||||
;; http://hydra.gnu.org/nar/…-foo-0.1
|
||||
;; http://hydra.gnu.org/log/…-foo-0.1
|
||||
|
||||
(rx "/" (or "store" "nar" "log") "/"
|
||||
;; Hash-parts do not include "e", "o", "u" and "t". See base32Chars
|
||||
;; at <https://github.com/NixOS/nix/blob/master/src/libutil/hash.cc>
|
||||
(group (= 32 (any "0-9" "a-d" "f-n" "p-s" "v-z"))))
|
||||
"Regexp matching file names for prettifying.
|
||||
|
||||
Disable `guix-prettify-mode' before modifying this variable and
|
||||
make sure to modify `guix-prettify-regexp-group' if needed.
|
||||
|
||||
Example of a \"deeper\" prettifying:
|
||||
|
||||
(setq guix-prettify-regexp \"store/[[:alnum:]]\\\\\\={32\\\\}\"
|
||||
guix-prettify-regexp-group 0)
|
||||
|
||||
This will transform
|
||||
'/gnu/store/72f54nfp6g1hz873w8z3gfcah0h4nl9p-foo-0.1' into
|
||||
'/gnu/…-foo-0.1'"
|
||||
:type 'regexp
|
||||
:group 'guix-prettify)
|
||||
|
||||
(defcustom guix-prettify-regexp-group 1
|
||||
"Regexp group in `guix-prettify-regexp' for prettifying."
|
||||
:type 'integer
|
||||
:group 'guix-prettify)
|
||||
|
||||
(defvar guix-prettify-special-modes
|
||||
'(guix-info-mode ibuffer-mode)
|
||||
"List of special modes that support font-locking.
|
||||
|
||||
By default, \\[global-guix-prettify-mode] enables prettifying in
|
||||
all buffers except the ones where `font-lock-defaults' is
|
||||
nil (see Info node `(elisp) Font Lock Basics'), because it may
|
||||
break the existing highlighting.
|
||||
|
||||
Modes from this list and all derived modes are exceptions
|
||||
\(`global-guix-prettify-mode' enables prettifying there).")
|
||||
|
||||
(defvar guix-prettify-flush-function
|
||||
(cond ((fboundp 'font-lock-flush) #'font-lock-flush)
|
||||
((fboundp 'jit-lock-refontify) #'jit-lock-refontify))
|
||||
"Function used to refontify buffer.
|
||||
This function is called without arguments after
|
||||
enabling/disabling `guix-prettify-mode'. If nil, do nothing.")
|
||||
|
||||
(defun guix-prettify-compose ()
|
||||
"Compose matching region in the current buffer."
|
||||
(let ((beg (match-beginning guix-prettify-regexp-group))
|
||||
(end (match-end guix-prettify-regexp-group)))
|
||||
(compose-region beg end guix-prettify-char 'decompose-region))
|
||||
;; Return nil because we're not adding any face property.
|
||||
nil)
|
||||
|
||||
(defun guix-prettify-decompose-buffer ()
|
||||
"Remove file names compositions from the current buffer."
|
||||
(with-silent-modifications
|
||||
(let ((inhibit-read-only t))
|
||||
(if guix-prettify-decompose-force
|
||||
(remove-text-properties (point-min)
|
||||
(point-max)
|
||||
'(composition nil))
|
||||
(guix-while-search guix-prettify-regexp
|
||||
(remove-text-properties
|
||||
(match-beginning guix-prettify-regexp-group)
|
||||
(match-end guix-prettify-regexp-group)
|
||||
'(composition nil)))))))
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode guix-prettify-mode
|
||||
"Toggle Guix Prettify mode.
|
||||
|
||||
With a prefix argument ARG, enable Guix Prettify mode if ARG is
|
||||
positive, and disable it otherwise. If called from Lisp, enable
|
||||
the mode if ARG is omitted or nil.
|
||||
|
||||
When Guix Prettify mode is enabled, hash-parts of the Guix store
|
||||
file names (see `guix-prettify-regexp') are prettified,
|
||||
i.e. displayed as `guix-prettify-char' character. This mode can
|
||||
be enabled programmatically using hooks:
|
||||
|
||||
(add-hook 'shell-mode-hook 'guix-prettify-mode)
|
||||
|
||||
It is possible to enable the mode in any buffer, however not any
|
||||
buffer's highlighting may survive after adding new elements to
|
||||
`font-lock-keywords' (see `guix-prettify-special-modes' for
|
||||
details).
|
||||
|
||||
Also you can use `global-guix-prettify-mode' to enable Guix
|
||||
Prettify mode for all modes that support font-locking."
|
||||
:init-value nil
|
||||
:lighter " …"
|
||||
(let ((keywords `((,guix-prettify-regexp
|
||||
(,guix-prettify-regexp-group
|
||||
(guix-prettify-compose))))))
|
||||
(if guix-prettify-mode
|
||||
;; Turn on.
|
||||
(font-lock-add-keywords nil keywords)
|
||||
;; Turn off.
|
||||
(font-lock-remove-keywords nil keywords)
|
||||
(guix-prettify-decompose-buffer))
|
||||
(and guix-prettify-flush-function
|
||||
(funcall guix-prettify-flush-function))))
|
||||
|
||||
(defun guix-prettify-supported-p ()
|
||||
"Return non-nil, if the mode can be harmlessly enabled in current buffer."
|
||||
(or font-lock-defaults
|
||||
(apply #'derived-mode-p guix-prettify-special-modes)))
|
||||
|
||||
(defun guix-prettify-turn-on ()
|
||||
"Enable `guix-prettify-mode' in the current buffer if needed.
|
||||
See `guix-prettify-special-modes' for details."
|
||||
(and (not guix-prettify-mode)
|
||||
(guix-prettify-supported-p)
|
||||
(guix-prettify-mode)))
|
||||
|
||||
;;;###autoload
|
||||
(define-globalized-minor-mode global-guix-prettify-mode
|
||||
guix-prettify-mode guix-prettify-turn-on)
|
||||
|
||||
;;;###autoload
|
||||
(defalias 'guix-prettify-global-mode 'global-guix-prettify-mode)
|
||||
|
||||
(provide 'guix-prettify)
|
||||
|
||||
;;; guix-prettify.el ends here
|
||||
@@ -1,77 +0,0 @@
|
||||
;;; guix-profiles.el --- Guix profiles
|
||||
|
||||
;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com>
|
||||
;; Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'guix-config)
|
||||
|
||||
(defvar guix-user-profile
|
||||
(expand-file-name "~/.guix-profile")
|
||||
"User profile.")
|
||||
|
||||
(defvar guix-system-profile
|
||||
(concat guix-config-state-directory "/profiles/system")
|
||||
"System profile.")
|
||||
|
||||
(defvar guix-default-profile
|
||||
(concat guix-config-state-directory
|
||||
"/profiles/per-user/"
|
||||
(getenv "USER")
|
||||
"/guix-profile")
|
||||
"Default Guix profile.")
|
||||
|
||||
(defvar guix-current-profile guix-default-profile
|
||||
"Current profile.")
|
||||
|
||||
(defvar guix-system-profile-regexp
|
||||
(concat "\\`" (regexp-quote guix-system-profile))
|
||||
"Regexp matching system profiles.")
|
||||
|
||||
(defun guix-system-profile? (profile)
|
||||
"Return non-nil, if PROFILE is a system one."
|
||||
(string-match-p guix-system-profile-regexp profile))
|
||||
|
||||
(defun guix-profile-prompt (&optional default)
|
||||
"Prompt for profile and return it.
|
||||
Use DEFAULT as a start directory. If it is nil, use
|
||||
`guix-current-profile'."
|
||||
(let* ((path (read-file-name "Profile: "
|
||||
(file-name-directory
|
||||
(or default guix-current-profile))))
|
||||
(path (directory-file-name (expand-file-name path))))
|
||||
(if (string= path guix-user-profile)
|
||||
guix-default-profile
|
||||
path)))
|
||||
|
||||
(defun guix-set-current-profile (path)
|
||||
"Set `guix-current-profile' to PATH.
|
||||
Interactively, prompt for PATH. With prefix, use
|
||||
`guix-default-profile'."
|
||||
(interactive
|
||||
(list (if current-prefix-arg
|
||||
guix-default-profile
|
||||
(guix-profile-prompt))))
|
||||
(setq guix-current-profile path)
|
||||
(message "Current profile has been set to '%s'."
|
||||
guix-current-profile))
|
||||
|
||||
(provide 'guix-profiles)
|
||||
|
||||
;;; guix-profiles.el ends here
|
||||
@@ -1,147 +0,0 @@
|
||||
;;; guix-read.el --- Minibuffer readers
|
||||
|
||||
;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides functions to prompt a user for packages, system
|
||||
;; types, hash formats and other guix related stuff.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'guix-help-vars)
|
||||
(require 'guix-utils)
|
||||
(require 'guix-backend)
|
||||
(require 'guix-guile)
|
||||
|
||||
|
||||
;;; Receivable lists of packages, lint checkers, etc.
|
||||
|
||||
(guix-memoized-defun guix-graph-type-names ()
|
||||
"Return a list of names of available graph node types."
|
||||
(guix-eval-read (guix-make-guile-expression 'graph-type-names)))
|
||||
|
||||
(guix-memoized-defun guix-refresh-updater-names ()
|
||||
"Return a list of names of available refresh updater types."
|
||||
(guix-eval-read (guix-make-guile-expression 'refresh-updater-names)))
|
||||
|
||||
(guix-memoized-defun guix-lint-checker-names ()
|
||||
"Return a list of names of available lint checkers."
|
||||
(guix-eval-read (guix-make-guile-expression 'lint-checker-names)))
|
||||
|
||||
(guix-memoized-defun guix-package-names ()
|
||||
"Return a list of names of available packages."
|
||||
(sort
|
||||
;; Work around <https://github.com/jaor/geiser/issues/64>:
|
||||
;; list of strings is parsed much slower than list of lists,
|
||||
;; so we use 'package-names-lists' instead of 'package-names'.
|
||||
|
||||
;; (guix-eval-read (guix-make-guile-expression 'package-names))
|
||||
|
||||
(mapcar #'car
|
||||
(guix-eval-read (guix-make-guile-expression
|
||||
'package-names-lists)))
|
||||
#'string<))
|
||||
|
||||
(guix-memoized-defun guix-license-names ()
|
||||
"Return a list of names of available licenses."
|
||||
(guix-eval-read (guix-make-guile-expression 'license-names)))
|
||||
|
||||
(guix-memoized-defun guix-package-locations ()
|
||||
"Return a list of available package locations."
|
||||
(sort (guix-eval-read (guix-make-guile-expression
|
||||
'package-location-files))
|
||||
#'string<))
|
||||
|
||||
|
||||
;;; Readers
|
||||
|
||||
(guix-define-readers
|
||||
:completions-var guix-help-system-types
|
||||
:single-reader guix-read-system-type
|
||||
:single-prompt "System type: ")
|
||||
|
||||
(guix-define-readers
|
||||
:completions-var guix-help-source-types
|
||||
:single-reader guix-read-source-type
|
||||
:single-prompt "Source type: ")
|
||||
|
||||
(guix-define-readers
|
||||
:completions-var guix-help-hash-formats
|
||||
:single-reader guix-read-hash-format
|
||||
:single-prompt "Hash format: ")
|
||||
|
||||
(guix-define-readers
|
||||
:completions-var guix-help-refresh-subsets
|
||||
:single-reader guix-read-refresh-subset
|
||||
:single-prompt "Refresh subset: ")
|
||||
|
||||
(guix-define-readers
|
||||
:completions-getter guix-refresh-updater-names
|
||||
:multiple-reader guix-read-refresh-updater-names
|
||||
:multiple-prompt "Refresh updater,s: "
|
||||
:multiple-separator ",")
|
||||
|
||||
(guix-define-readers
|
||||
:completions-var guix-help-key-policies
|
||||
:single-reader guix-read-key-policy
|
||||
:single-prompt "Key policy: ")
|
||||
|
||||
(guix-define-readers
|
||||
:completions-var guix-help-elpa-archives
|
||||
:single-reader guix-read-elpa-archive
|
||||
:single-prompt "ELPA archive: ")
|
||||
|
||||
(guix-define-readers
|
||||
:completions-var guix-help-verify-options
|
||||
:multiple-reader guix-read-verify-options
|
||||
:multiple-prompt "Verify option,s: "
|
||||
:multiple-separator ",")
|
||||
|
||||
(guix-define-readers
|
||||
:completions-getter guix-graph-type-names
|
||||
:single-reader guix-read-graph-type
|
||||
:single-prompt "Graph node type: ")
|
||||
|
||||
(guix-define-readers
|
||||
:completions-getter guix-lint-checker-names
|
||||
:multiple-reader guix-read-lint-checker-names
|
||||
:multiple-prompt "Linter,s: "
|
||||
:multiple-separator ",")
|
||||
|
||||
(guix-define-readers
|
||||
:completions-getter guix-package-names
|
||||
:single-reader guix-read-package-name
|
||||
:single-prompt "Package: "
|
||||
:multiple-reader guix-read-package-names
|
||||
:multiple-prompt "Package,s: "
|
||||
:multiple-separator " ")
|
||||
|
||||
(guix-define-readers
|
||||
:completions-getter guix-license-names
|
||||
:single-reader guix-read-license-name
|
||||
:single-prompt "License: ")
|
||||
|
||||
(guix-define-readers
|
||||
:completions-getter guix-package-locations
|
||||
:single-reader guix-read-package-location
|
||||
:single-prompt "Location: ")
|
||||
|
||||
(provide 'guix-read)
|
||||
|
||||
;;; guix-read.el ends here
|
||||
@@ -1,456 +0,0 @@
|
||||
;;; guix-ui-generation.el --- Interface for displaying generations -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides an interface for displaying profile generations in
|
||||
;; 'list' and 'info' buffers, and commands for working with them.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'guix-buffer)
|
||||
(require 'guix-list)
|
||||
(require 'guix-info)
|
||||
(require 'guix-ui)
|
||||
(require 'guix-ui-package)
|
||||
(require 'guix-base)
|
||||
(require 'guix-backend)
|
||||
(require 'guix-guile)
|
||||
(require 'guix-entry)
|
||||
(require 'guix-utils)
|
||||
(require 'guix-profiles)
|
||||
|
||||
(guix-ui-define-entry-type generation)
|
||||
|
||||
(defun guix-generation-get-display (profile search-type &rest search-values)
|
||||
"Search for generations and show results.
|
||||
|
||||
If PROFILE is nil, use `guix-current-profile'.
|
||||
|
||||
See `guix-ui-get-entries' for the meaning of SEARCH-TYPE and
|
||||
SEARCH-VALUES."
|
||||
(apply #'guix-list-get-display-entries
|
||||
'generation
|
||||
(or profile guix-current-profile)
|
||||
search-type search-values))
|
||||
|
||||
(defun guix-delete-generations (profile generations
|
||||
&optional operation-buffer)
|
||||
"Delete GENERATIONS from PROFILE.
|
||||
Each element from GENERATIONS is a generation number."
|
||||
(when (or (not guix-operation-confirm)
|
||||
(y-or-n-p
|
||||
(let ((count (length generations)))
|
||||
(if (> count 1)
|
||||
(format "Delete %d generations from profile '%s'? "
|
||||
count profile)
|
||||
(format "Delete generation %d from profile '%s'? "
|
||||
(car generations) profile)))))
|
||||
(guix-eval-in-repl
|
||||
(guix-make-guile-expression
|
||||
'delete-generations* profile generations)
|
||||
operation-buffer)))
|
||||
|
||||
(defun guix-switch-to-generation (profile generation
|
||||
&optional operation-buffer)
|
||||
"Switch PROFILE to GENERATION."
|
||||
(when (or (not guix-operation-confirm)
|
||||
(y-or-n-p (format "Switch profile '%s' to generation %d? "
|
||||
profile generation)))
|
||||
(guix-eval-in-repl
|
||||
(guix-make-guile-expression
|
||||
'switch-to-generation* profile generation)
|
||||
operation-buffer)))
|
||||
|
||||
(defun guix-system-generation? ()
|
||||
"Return non-nil, if current generation is a system one."
|
||||
(eq (guix-buffer-current-entry-type)
|
||||
'system-generation))
|
||||
|
||||
(defun guix-generation-current-packages-profile (&optional generation)
|
||||
"Return a directory where packages are installed for the
|
||||
current profile's GENERATION."
|
||||
(guix-packages-profile (guix-ui-current-profile)
|
||||
generation
|
||||
(guix-system-generation?)))
|
||||
|
||||
|
||||
;;; Generation 'info'
|
||||
|
||||
(guix-ui-info-define-interface generation
|
||||
:buffer-name "*Guix Generation Info*"
|
||||
:format '((number format guix-generation-info-insert-number)
|
||||
(prev-number format (format))
|
||||
(current format guix-generation-info-insert-current)
|
||||
(path simple (indent guix-file))
|
||||
(time format (time)))
|
||||
:titles '((path . "File name")
|
||||
(prev-number . "Previous number")))
|
||||
|
||||
(defface guix-generation-info-number
|
||||
'((t :inherit font-lock-keyword-face))
|
||||
"Face used for a number of a generation."
|
||||
:group 'guix-generation-info-faces)
|
||||
|
||||
(defface guix-generation-info-current
|
||||
'((t :inherit guix-package-info-installed-outputs))
|
||||
"Face used if a generation is the current one."
|
||||
:group 'guix-generation-info-faces)
|
||||
|
||||
(defface guix-generation-info-not-current
|
||||
'((t nil))
|
||||
"Face used if a generation is not the current one."
|
||||
:group 'guix-generation-info-faces)
|
||||
|
||||
(defun guix-generation-info-insert-number (number &optional _)
|
||||
"Insert generation NUMBER and action buttons."
|
||||
(guix-info-insert-value-format number 'guix-generation-info-number)
|
||||
(guix-info-insert-indent)
|
||||
(guix-info-insert-action-button
|
||||
"Packages"
|
||||
(lambda (btn)
|
||||
(guix-buffer-get-display-entries
|
||||
'list guix-package-list-type
|
||||
(list (guix-generation-current-packages-profile
|
||||
(button-get btn 'number))
|
||||
'installed)
|
||||
'add))
|
||||
"Show installed packages for this generation"
|
||||
'number number)
|
||||
(guix-info-insert-indent)
|
||||
(guix-info-insert-action-button
|
||||
"Delete"
|
||||
(lambda (btn)
|
||||
(guix-delete-generations (guix-ui-current-profile)
|
||||
(list (button-get btn 'number))
|
||||
(current-buffer)))
|
||||
"Delete this generation"
|
||||
'number number))
|
||||
|
||||
(defun guix-generation-info-insert-current (val entry)
|
||||
"Insert boolean value VAL showing whether this generation is current."
|
||||
(if val
|
||||
(guix-info-insert-value-format "Yes" 'guix-generation-info-current)
|
||||
(guix-info-insert-value-format "No" 'guix-generation-info-not-current)
|
||||
(guix-info-insert-indent)
|
||||
(guix-info-insert-action-button
|
||||
"Switch"
|
||||
(lambda (btn)
|
||||
(guix-switch-to-generation (guix-ui-current-profile)
|
||||
(button-get btn 'number)
|
||||
(current-buffer)))
|
||||
"Switch to this generation (make it the current one)"
|
||||
'number (guix-entry-value entry 'number))))
|
||||
|
||||
|
||||
;;; Generation 'list'
|
||||
|
||||
(guix-ui-list-define-interface generation
|
||||
:buffer-name "*Guix Generation List*"
|
||||
:format '((number nil 5 guix-list-sort-numerically-0 :right-align t)
|
||||
(current guix-generation-list-get-current 10 t)
|
||||
(time guix-list-get-time 20 t)
|
||||
(path guix-list-get-file-name 30 t))
|
||||
:titles '((number . "N."))
|
||||
:sort-key '(number . t)
|
||||
:marks '((delete . ?D)))
|
||||
|
||||
(let ((map guix-generation-list-mode-map))
|
||||
(define-key map (kbd "RET") 'guix-generation-list-show-packages)
|
||||
(define-key map (kbd "+") 'guix-generation-list-show-added-packages)
|
||||
(define-key map (kbd "-") 'guix-generation-list-show-removed-packages)
|
||||
(define-key map (kbd "=") 'guix-generation-list-diff)
|
||||
(define-key map (kbd "D") 'guix-generation-list-diff)
|
||||
(define-key map (kbd "e") 'guix-generation-list-ediff)
|
||||
(define-key map (kbd "x") 'guix-generation-list-execute)
|
||||
(define-key map (kbd "s") 'guix-generation-list-switch)
|
||||
(define-key map (kbd "c") 'guix-generation-list-switch)
|
||||
(define-key map (kbd "d") 'guix-generation-list-mark-delete))
|
||||
|
||||
(defun guix-generation-list-get-current (val &optional _)
|
||||
"Return string from VAL showing whether this generation is current.
|
||||
VAL is a boolean value."
|
||||
(if val "(current)" ""))
|
||||
|
||||
(defun guix-generation-list-switch ()
|
||||
"Switch current profile to the generation at point."
|
||||
(interactive)
|
||||
(let* ((entry (guix-list-current-entry))
|
||||
(current (guix-entry-value entry 'current))
|
||||
(number (guix-entry-value entry 'number)))
|
||||
(if current
|
||||
(user-error "This generation is already the current one")
|
||||
(guix-switch-to-generation (guix-ui-current-profile)
|
||||
number (current-buffer)))))
|
||||
|
||||
(defun guix-generation-list-show-packages ()
|
||||
"List installed packages for the generation at point."
|
||||
(interactive)
|
||||
(guix-package-get-display
|
||||
(guix-generation-current-packages-profile (guix-list-current-id))
|
||||
'installed))
|
||||
|
||||
(defun guix-generation-list-generations-to-compare ()
|
||||
"Return a sorted list of 2 marked generations for comparing."
|
||||
(let ((numbers (guix-list-get-marked-id-list 'general)))
|
||||
(if (/= (length numbers) 2)
|
||||
(user-error "2 generations should be marked for comparing")
|
||||
(sort numbers #'<))))
|
||||
|
||||
(defun guix-generation-list-profiles-to-compare ()
|
||||
"Return a sorted list of 2 marked generation profiles for comparing."
|
||||
(mapcar #'guix-generation-current-packages-profile
|
||||
(guix-generation-list-generations-to-compare)))
|
||||
|
||||
(defun guix-generation-list-show-added-packages ()
|
||||
"List package outputs added to the latest marked generation.
|
||||
If 2 generations are marked with \\[guix-list-mark], display
|
||||
outputs installed in the latest marked generation that were not
|
||||
installed in the other one."
|
||||
(interactive)
|
||||
(guix-buffer-get-display-entries
|
||||
'list 'output
|
||||
(cl-list* (guix-ui-current-profile)
|
||||
'profile-diff
|
||||
(reverse (guix-generation-list-profiles-to-compare)))
|
||||
'add))
|
||||
|
||||
(defun guix-generation-list-show-removed-packages ()
|
||||
"List package outputs removed from the latest marked generation.
|
||||
If 2 generations are marked with \\[guix-list-mark], display
|
||||
outputs not installed in the latest marked generation that were
|
||||
installed in the other one."
|
||||
(interactive)
|
||||
(guix-buffer-get-display-entries
|
||||
'list 'output
|
||||
(cl-list* (guix-ui-current-profile)
|
||||
'profile-diff
|
||||
(guix-generation-list-profiles-to-compare))
|
||||
'add))
|
||||
|
||||
(defun guix-generation-list-compare (diff-fun gen-fun)
|
||||
"Run GEN-FUN on the 2 marked generations and run DIFF-FUN on the results."
|
||||
(cl-multiple-value-bind (gen1 gen2)
|
||||
(guix-generation-list-generations-to-compare)
|
||||
(funcall diff-fun
|
||||
(funcall gen-fun gen1)
|
||||
(funcall gen-fun gen2))))
|
||||
|
||||
(defun guix-generation-list-ediff-manifests ()
|
||||
"Run Ediff on manifests of the 2 marked generations."
|
||||
(interactive)
|
||||
(guix-generation-list-compare
|
||||
#'ediff-files
|
||||
#'guix-profile-generation-manifest-file))
|
||||
|
||||
(defun guix-generation-list-diff-manifests ()
|
||||
"Run Diff on manifests of the 2 marked generations."
|
||||
(interactive)
|
||||
(guix-generation-list-compare
|
||||
#'guix-diff
|
||||
#'guix-profile-generation-manifest-file))
|
||||
|
||||
(defun guix-generation-list-ediff-packages ()
|
||||
"Run Ediff on package outputs installed in the 2 marked generations."
|
||||
(interactive)
|
||||
(guix-generation-list-compare
|
||||
#'ediff-buffers
|
||||
#'guix-profile-generation-packages-buffer))
|
||||
|
||||
(defun guix-generation-list-diff-packages ()
|
||||
"Run Diff on package outputs installed in the 2 marked generations."
|
||||
(interactive)
|
||||
(guix-generation-list-compare
|
||||
#'guix-diff
|
||||
#'guix-profile-generation-packages-buffer))
|
||||
|
||||
(defun guix-generation-list-ediff (arg)
|
||||
"Run Ediff on package outputs installed in the 2 marked generations.
|
||||
With ARG, run Ediff on manifests of the marked generations."
|
||||
(interactive "P")
|
||||
(if arg
|
||||
(guix-generation-list-ediff-manifests)
|
||||
(guix-generation-list-ediff-packages)))
|
||||
|
||||
(defun guix-generation-list-diff (arg)
|
||||
"Run Diff on package outputs installed in the 2 marked generations.
|
||||
With ARG, run Diff on manifests of the marked generations."
|
||||
(interactive "P")
|
||||
(if arg
|
||||
(guix-generation-list-diff-manifests)
|
||||
(guix-generation-list-diff-packages)))
|
||||
|
||||
(defun guix-generation-list-mark-delete (&optional arg)
|
||||
"Mark the current generation for deletion and move to the next line.
|
||||
With ARG, mark all generations for deletion."
|
||||
(interactive "P")
|
||||
(if arg
|
||||
(guix-list-mark-all 'delete)
|
||||
(guix-list--mark 'delete t)))
|
||||
|
||||
(defun guix-generation-list-execute ()
|
||||
"Delete marked generations."
|
||||
(interactive)
|
||||
(let ((marked (guix-list-get-marked-id-list 'delete)))
|
||||
(or marked
|
||||
(user-error "No generations marked for deletion"))
|
||||
(guix-delete-generations (guix-ui-current-profile)
|
||||
marked (current-buffer))))
|
||||
|
||||
|
||||
;;; Inserting packages to compare generations
|
||||
|
||||
(defcustom guix-generation-packages-buffer-name-function
|
||||
#'guix-generation-packages-buffer-name-default
|
||||
"Function used to define name of a buffer with generation packages.
|
||||
This function is called with 2 arguments: PROFILE (string) and
|
||||
GENERATION (number)."
|
||||
:type '(choice (function-item guix-generation-packages-buffer-name-default)
|
||||
(function-item guix-generation-packages-buffer-name-long)
|
||||
(function :tag "Other function"))
|
||||
:group 'guix-generation)
|
||||
|
||||
(defcustom guix-generation-packages-update-buffer t
|
||||
"If non-nil, always update list of packages during comparing generations.
|
||||
If nil, generation packages are received only once. So when you
|
||||
compare generation 1 and generation 2, the packages for both
|
||||
generations will be received. Then if you compare generation 1
|
||||
and generation 3, only the packages for generation 3 will be
|
||||
received. Thus if you use comparing of different generations a
|
||||
lot, you may set this variable to nil to improve the
|
||||
performance."
|
||||
:type 'boolean
|
||||
:group 'guix-generation)
|
||||
|
||||
(defvar guix-generation-output-name-width 30
|
||||
"Width of an output name \"column\".
|
||||
This variable is used in auxiliary buffers for comparing generations.")
|
||||
|
||||
(defun guix-generation-packages (profile)
|
||||
"Return a list of sorted packages installed in PROFILE.
|
||||
Each element of the list is a list of the package specification
|
||||
and its store path."
|
||||
(let ((names+paths (guix-eval-read
|
||||
(guix-make-guile-expression
|
||||
'profile->specifications+paths profile))))
|
||||
(sort names+paths
|
||||
(lambda (a b)
|
||||
(string< (car a) (car b))))))
|
||||
|
||||
(defun guix-generation-packages-buffer-name-default (profile generation)
|
||||
"Return name of a buffer for displaying GENERATION's package outputs.
|
||||
Use base name of PROFILE file name."
|
||||
(let ((profile-name (file-name-base (directory-file-name profile))))
|
||||
(format "*Guix %s: generation %s*"
|
||||
profile-name generation)))
|
||||
|
||||
(defun guix-generation-packages-buffer-name-long (profile generation)
|
||||
"Return name of a buffer for displaying GENERATION's package outputs.
|
||||
Use the full PROFILE file name."
|
||||
(format "*Guix generation %s (%s)*"
|
||||
generation profile))
|
||||
|
||||
(defun guix-generation-packages-buffer-name (profile generation)
|
||||
"Return name of a buffer for displaying GENERATION's package outputs."
|
||||
(funcall guix-generation-packages-buffer-name-function
|
||||
profile generation))
|
||||
|
||||
(defun guix-generation-insert-package (name path)
|
||||
"Insert package output NAME and store PATH at point."
|
||||
(insert name)
|
||||
(indent-to guix-generation-output-name-width 2)
|
||||
(insert path "\n"))
|
||||
|
||||
(defun guix-generation-insert-packages (buffer profile)
|
||||
"Insert package outputs installed in PROFILE in BUFFER."
|
||||
(with-current-buffer buffer
|
||||
(setq buffer-read-only nil
|
||||
indent-tabs-mode nil)
|
||||
(erase-buffer)
|
||||
(mapc (lambda (name+path)
|
||||
(guix-generation-insert-package
|
||||
(car name+path) (cadr name+path)))
|
||||
(guix-generation-packages profile))))
|
||||
|
||||
(defun guix-generation-packages-buffer (profile generation &optional system?)
|
||||
"Return buffer with package outputs installed in PROFILE's GENERATION.
|
||||
Create the buffer if needed."
|
||||
(let ((buf-name (guix-generation-packages-buffer-name
|
||||
profile generation)))
|
||||
(or (and (null guix-generation-packages-update-buffer)
|
||||
(get-buffer buf-name))
|
||||
(let ((buf (get-buffer-create buf-name)))
|
||||
(guix-generation-insert-packages
|
||||
buf
|
||||
(guix-packages-profile profile generation system?))
|
||||
buf))))
|
||||
|
||||
(defun guix-profile-generation-manifest-file (generation)
|
||||
"Return the file name of a GENERATION's manifest.
|
||||
GENERATION is a generation number of the current profile."
|
||||
(guix-manifest-file (guix-ui-current-profile)
|
||||
generation
|
||||
(guix-system-generation?)))
|
||||
|
||||
(defun guix-profile-generation-packages-buffer (generation)
|
||||
"Insert GENERATION's package outputs in a buffer and return it.
|
||||
GENERATION is a generation number of the current profile."
|
||||
(guix-generation-packages-buffer (guix-ui-current-profile)
|
||||
generation
|
||||
(guix-system-generation?)))
|
||||
|
||||
|
||||
;;; Interactive commands
|
||||
|
||||
;;;###autoload
|
||||
(defun guix-generations (&optional profile)
|
||||
"Display information about all generations.
|
||||
If PROFILE is nil, use `guix-current-profile'.
|
||||
Interactively with prefix, prompt for PROFILE."
|
||||
(interactive (list (guix-ui-read-profile)))
|
||||
(guix-generation-get-display profile 'all))
|
||||
|
||||
;;;###autoload
|
||||
(defun guix-last-generations (number &optional profile)
|
||||
"Display information about last NUMBER generations.
|
||||
If PROFILE is nil, use `guix-current-profile'.
|
||||
Interactively with prefix, prompt for PROFILE."
|
||||
(interactive
|
||||
(list (read-number "The number of last generations: ")
|
||||
(guix-ui-read-profile)))
|
||||
(guix-generation-get-display profile 'last number))
|
||||
|
||||
;;;###autoload
|
||||
(defun guix-generations-by-time (from to &optional profile)
|
||||
"Display information about generations created between FROM and TO.
|
||||
FROM and TO should be time values.
|
||||
If PROFILE is nil, use `guix-current-profile'.
|
||||
Interactively with prefix, prompt for PROFILE."
|
||||
(interactive
|
||||
(list (guix-read-date "Find generations (from): ")
|
||||
(guix-read-date "Find generations (to): ")
|
||||
(guix-ui-read-profile)))
|
||||
(guix-generation-get-display profile 'time
|
||||
(float-time from)
|
||||
(float-time to)))
|
||||
|
||||
(provide 'guix-ui-generation)
|
||||
|
||||
;;; guix-ui-generation.el ends here
|
||||
@@ -1,150 +0,0 @@
|
||||
;;; guix-ui-license.el --- Interface for displaying licenses
|
||||
|
||||
;; Copyright © 2016 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides 'list'/'info' interface for displaying licenses of
|
||||
;; Guix packages.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'guix-buffer)
|
||||
(require 'guix-list)
|
||||
(require 'guix-info)
|
||||
(require 'guix-backend)
|
||||
(require 'guix-guile)
|
||||
(require 'guix-license)
|
||||
|
||||
(guix-define-entry-type license)
|
||||
|
||||
(defun guix-license-get-entries (search-type &rest args)
|
||||
"Receive 'license' entries.
|
||||
SEARCH-TYPE may be one of the following symbols: `all', `id', `name'."
|
||||
(guix-eval-read
|
||||
(apply #'guix-make-guile-expression
|
||||
'license-entries search-type args)))
|
||||
|
||||
(defun guix-license-get-display (search-type &rest args)
|
||||
"Search for licenses and show results."
|
||||
(apply #'guix-list-get-display-entries
|
||||
'license search-type args))
|
||||
|
||||
(defun guix-license-message (entries search-type &rest args)
|
||||
"Display a message after showing license ENTRIES."
|
||||
;; Some objects in (guix licenses) module are procedures (e.g.,
|
||||
;; 'non-copyleft' or 'x11-style'). Such licenses cannot be "described".
|
||||
(when (null entries)
|
||||
(if (cdr args)
|
||||
(message "Unknown licenses.")
|
||||
(message "Unknown license."))))
|
||||
|
||||
|
||||
;;; License 'info'
|
||||
|
||||
(guix-info-define-interface license
|
||||
:buffer-name "*Guix License Info*"
|
||||
:get-entries-function 'guix-license-get-entries
|
||||
:message-function 'guix-license-message
|
||||
:format '((name ignore (simple guix-info-heading))
|
||||
ignore
|
||||
guix-license-insert-packages-button
|
||||
(url ignore (simple guix-url))
|
||||
guix-license-insert-comment
|
||||
ignore
|
||||
guix-license-insert-file)
|
||||
:titles '((url . "URL")))
|
||||
|
||||
(declare-function guix-packages-by-license "guix-ui-package")
|
||||
|
||||
(defun guix-license-insert-packages-button (entry)
|
||||
"Insert button to display packages by license ENTRY."
|
||||
(let ((license (guix-entry-value entry 'name)))
|
||||
(guix-info-insert-action-button
|
||||
"Packages"
|
||||
(lambda (btn)
|
||||
(guix-packages-by-license (button-get btn 'license)))
|
||||
(format "Display packages with license '%s'" license)
|
||||
'license license)))
|
||||
|
||||
(defun guix-license-insert-comment (entry)
|
||||
"Insert 'comment' of a license ENTRY."
|
||||
(let ((comment (guix-entry-value entry 'comment)))
|
||||
(if (and comment
|
||||
(string-match-p "^http" comment))
|
||||
(guix-info-insert-value-simple comment 'guix-url)
|
||||
(guix-info-insert-title-simple
|
||||
(guix-info-param-title 'license 'comment))
|
||||
(guix-info-insert-value-indent comment))))
|
||||
|
||||
(defun guix-license-insert-file (entry)
|
||||
"Insert button to open license definition."
|
||||
(let ((license (guix-entry-value entry 'name)))
|
||||
(guix-insert-button
|
||||
(guix-license-file) 'guix-file
|
||||
'help-echo (format "Open definition of license '%s'" license)
|
||||
'action (lambda (btn)
|
||||
(guix-find-license-definition (button-get btn 'license)))
|
||||
'license license)))
|
||||
|
||||
|
||||
;;; License 'list'
|
||||
|
||||
(guix-list-define-interface license
|
||||
:buffer-name "*Guix Licenses*"
|
||||
:get-entries-function 'guix-license-get-entries
|
||||
:describe-function 'guix-license-list-describe
|
||||
:message-function 'guix-license-message
|
||||
:format '((name nil 40 t)
|
||||
(url guix-list-get-url 50 t))
|
||||
:titles '((name . "License"))
|
||||
:sort-key '(name))
|
||||
|
||||
(let ((map guix-license-list-mode-map))
|
||||
(define-key map (kbd "e") 'guix-license-list-edit)
|
||||
(define-key map (kbd "RET") 'guix-license-list-show-packages))
|
||||
|
||||
(defun guix-license-list-describe (ids)
|
||||
"Describe licenses with IDS (list of identifiers)."
|
||||
(guix-buffer-display-entries
|
||||
(guix-entries-by-ids ids (guix-buffer-current-entries))
|
||||
'info 'license (cl-list* 'id ids) 'add))
|
||||
|
||||
(defun guix-license-list-show-packages ()
|
||||
"Display packages with the license at point."
|
||||
(interactive)
|
||||
(guix-packages-by-license (guix-list-current-id)))
|
||||
|
||||
(defun guix-license-list-edit (&optional directory)
|
||||
"Go to the location of the current license definition.
|
||||
See `guix-license-file' for the meaning of DIRECTORY."
|
||||
(interactive (list (guix-read-directory)))
|
||||
(guix-find-license-definition (guix-list-current-id) directory))
|
||||
|
||||
|
||||
;;; Interactive commands
|
||||
|
||||
;;;###autoload
|
||||
(defun guix-licenses ()
|
||||
"Display licenses of the Guix packages."
|
||||
(interactive)
|
||||
(guix-license-get-display 'all))
|
||||
|
||||
(provide 'guix-ui-license)
|
||||
|
||||
;;; guix-ui-license.el ends here
|
||||
@@ -1,83 +0,0 @@
|
||||
;;; guix-ui-location.el --- Interface for displaying package locations
|
||||
|
||||
;; Copyright © 2016 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public Location as published by
|
||||
;; the Free Software Foundation, either version 3 of the Location, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public Location for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public Location
|
||||
;; along with this program. If not, see <http://www.gnu.org/locations/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides a 'list' interface for displaying locations of Guix
|
||||
;; packages.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'guix-buffer)
|
||||
(require 'guix-list)
|
||||
(require 'guix-location)
|
||||
(require 'guix-backend)
|
||||
|
||||
(guix-define-entry-type location)
|
||||
|
||||
(defun guix-location-get-entries ()
|
||||
"Receive 'package location' entries."
|
||||
(guix-eval-read "(package-location-entries)"))
|
||||
|
||||
|
||||
;;; Location 'list'
|
||||
|
||||
(guix-list-define-interface location
|
||||
:buffer-name "*Guix Package Locations*"
|
||||
:get-entries-function 'guix-location-get-entries
|
||||
:format '((location guix-location-list-file-name-specification 50 t)
|
||||
(number-of-packages nil 10 guix-list-sort-numerically-1
|
||||
:right-align t))
|
||||
:sort-key '(location))
|
||||
|
||||
(let ((map guix-location-list-mode-map))
|
||||
(define-key map (kbd "RET") 'guix-location-list-show-packages)
|
||||
;; "Location Info" buffer is not defined (it would be useless), so
|
||||
;; unbind "i" key (by default, it is used to display Info buffer).
|
||||
(define-key map (kbd "i") nil))
|
||||
|
||||
(defun guix-location-list-file-name-specification (location &optional _)
|
||||
"Return LOCATION button specification for `tabulated-list-entries'."
|
||||
(list location
|
||||
'face 'guix-list-file-name
|
||||
'action (lambda (btn)
|
||||
(guix-find-location (button-get btn 'location)))
|
||||
'follow-link t
|
||||
'help-echo (concat "Find location: " location)
|
||||
'location location))
|
||||
|
||||
(declare-function guix-packages-by-location "guix-ui-package")
|
||||
|
||||
(defun guix-location-list-show-packages ()
|
||||
"Display packages placed in the location at point."
|
||||
(interactive)
|
||||
(guix-packages-by-location (guix-list-current-id)))
|
||||
|
||||
|
||||
;;; Interactive commands
|
||||
|
||||
;;;###autoload
|
||||
(defun guix-locations ()
|
||||
"Display locations of the Guix packages."
|
||||
(interactive)
|
||||
(guix-list-get-display-entries 'location))
|
||||
|
||||
(provide 'guix-ui-location)
|
||||
|
||||
;;; guix-ui-location.el ends here
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,105 +0,0 @@
|
||||
;;; guix-ui-system-generation.el --- Interface for displaying system generations -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright © 2016 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides an interface for displaying system generations
|
||||
;; in 'list' and 'info' buffers, and commands for working with them.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'guix-list)
|
||||
(require 'guix-ui)
|
||||
(require 'guix-ui-generation)
|
||||
(require 'guix-profiles)
|
||||
|
||||
(guix-ui-define-entry-type system-generation)
|
||||
|
||||
(defun guix-system-generation-get-display (search-type &rest search-values)
|
||||
"Search for system generations and show results.
|
||||
See `guix-ui-get-entries' for the meaning of SEARCH-TYPE and
|
||||
SEARCH-VALUES."
|
||||
(apply #'guix-list-get-display-entries
|
||||
'system-generation
|
||||
guix-system-profile
|
||||
search-type search-values))
|
||||
|
||||
|
||||
;;; System generation 'info'
|
||||
|
||||
(guix-ui-info-define-interface system-generation
|
||||
:buffer-name "*Guix Generation Info*"
|
||||
:format '((number format guix-generation-info-insert-number)
|
||||
(label format (format))
|
||||
(prev-number format (format))
|
||||
(current format guix-generation-info-insert-current)
|
||||
(path format (format guix-file))
|
||||
(time format (time))
|
||||
(root-device format (format))
|
||||
(kernel format (format guix-file)))
|
||||
:titles guix-generation-info-titles)
|
||||
|
||||
|
||||
;;; System generation 'list'
|
||||
|
||||
;; FIXME It is better to make `guix-generation-list-shared-map' with
|
||||
;; common keys for both usual and system generations.
|
||||
(defvar guix-system-generation-list-mode-map
|
||||
(copy-keymap guix-generation-list-mode-map)
|
||||
"Keymap for `guix-system-generation-list-mode' buffers.")
|
||||
|
||||
(guix-ui-list-define-interface system-generation
|
||||
:buffer-name "*Guix Generation List*"
|
||||
:format '((number nil 5 guix-list-sort-numerically-0 :right-align t)
|
||||
(current guix-generation-list-get-current 10 t)
|
||||
(label nil 40 t)
|
||||
(time guix-list-get-time 20 t)
|
||||
(path guix-list-get-file-name 30 t))
|
||||
:titles guix-generation-list-titles
|
||||
:sort-key '(number . t)
|
||||
:marks '((delete . ?D)))
|
||||
|
||||
|
||||
;;; Interactive commands
|
||||
|
||||
;;;###autoload
|
||||
(defun guix-system-generations ()
|
||||
"Display information about system generations."
|
||||
(interactive)
|
||||
(guix-system-generation-get-display 'all))
|
||||
|
||||
;;;###autoload
|
||||
(defun guix-last-system-generations (number)
|
||||
"Display information about last NUMBER of system generations."
|
||||
(interactive "nThe number of last generations: ")
|
||||
(guix-system-generation-get-display 'last number))
|
||||
|
||||
;;;###autoload
|
||||
(defun guix-system-generations-by-time (from to)
|
||||
"Display information about system generations created between FROM and TO."
|
||||
(interactive
|
||||
(list (guix-read-date "Find generations (from): ")
|
||||
(guix-read-date "Find generations (to): ")))
|
||||
(guix-system-generation-get-display
|
||||
'time (float-time from) (float-time to)))
|
||||
|
||||
(provide 'guix-ui-system-generation)
|
||||
|
||||
;;; guix-ui-system-generation.el ends here
|
||||
@@ -1,323 +0,0 @@
|
||||
;;; guix-ui.el --- Common code for Guix package management interface -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides some general code for 'list'/'info' interfaces for
|
||||
;; packages and generations.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'guix-backend)
|
||||
(require 'guix-buffer)
|
||||
(require 'guix-guile)
|
||||
(require 'guix-utils)
|
||||
(require 'guix-messages)
|
||||
(require 'guix-profiles)
|
||||
|
||||
(guix-define-groups ui
|
||||
:group-doc "\
|
||||
Settings for 'ui' (Guix package management) buffers.
|
||||
This group includes settings for displaying packages, outputs and
|
||||
generations in 'list' and 'info' buffers.")
|
||||
|
||||
(defvar guix-ui-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map (kbd "M") 'guix-apply-manifest)
|
||||
(define-key map (kbd "C-c C-z") 'guix-switch-to-repl)
|
||||
map)
|
||||
"Parent keymap for Guix package/generation buffers.")
|
||||
|
||||
(guix-buffer-define-current-args-accessors
|
||||
"guix-ui-current" "profile" "search-type" "search-values")
|
||||
|
||||
(defun guix-ui-read-profile ()
|
||||
"Return `guix-current-profile' or prompt for it.
|
||||
This function is intended for using in `interactive' forms."
|
||||
(if current-prefix-arg
|
||||
(guix-profile-prompt)
|
||||
guix-current-profile))
|
||||
|
||||
(defun guix-ui-get-entries (profile entry-type search-type search-values
|
||||
&optional params)
|
||||
"Receive ENTRY-TYPE entries for PROFILE.
|
||||
Call an appropriate scheme procedure and return a list of entries.
|
||||
|
||||
ENTRY-TYPE should be one of the following symbols: `package',
|
||||
`output' or `generation'.
|
||||
|
||||
SEARCH-TYPE may be one of the following symbols:
|
||||
|
||||
- If ENTRY-TYPE is `package' or `output': `id', `name', `regexp',
|
||||
`all-available', `newest-available', `installed', `obsolete',
|
||||
`generation'.
|
||||
|
||||
- If ENTRY-TYPE is `generation': `id', `last', `all', `time'.
|
||||
|
||||
PARAMS is a list of parameters for receiving. If nil, get data
|
||||
with all available parameters."
|
||||
(guix-eval-read
|
||||
(guix-make-guile-expression
|
||||
'entries
|
||||
profile params entry-type search-type search-values)))
|
||||
|
||||
(defun guix-ui-list-describe (ids)
|
||||
"Describe 'ui' entries with IDS (list of identifiers)."
|
||||
(guix-buffer-get-display-entries
|
||||
'info (guix-buffer-current-entry-type)
|
||||
(cl-list* (guix-ui-current-profile) 'id ids)
|
||||
'add))
|
||||
|
||||
|
||||
;;; Buffers and auto updating
|
||||
|
||||
(defcustom guix-ui-update-after-operation 'current
|
||||
"Define what kind of data to update after executing an operation.
|
||||
|
||||
After successful executing an operation in the Guix REPL (for
|
||||
example after installing a package), the data in Guix buffers
|
||||
will or will not be automatically updated depending on a value of
|
||||
this variable.
|
||||
|
||||
If nil, update nothing (do not revert any buffer).
|
||||
If `current', update the buffer from which an operation was performed.
|
||||
If `all', update all Guix buffers (not recommended)."
|
||||
:type '(choice (const :tag "Do nothing" nil)
|
||||
(const :tag "Update operation buffer" current)
|
||||
(const :tag "Update all Guix buffers" all))
|
||||
:group 'guix-ui)
|
||||
|
||||
(defcustom guix-ui-buffer-name-function
|
||||
#'guix-ui-buffer-name-full
|
||||
"Function used to define a name of a Guix buffer.
|
||||
The function is called with 2 arguments: BASE-NAME and PROFILE."
|
||||
:type '(choice (function-item guix-ui-buffer-name-full)
|
||||
(function-item guix-ui-buffer-name-short)
|
||||
(function-item guix-ui-buffer-name-simple)
|
||||
(function :tag "Other function"))
|
||||
:group 'guix-ui)
|
||||
|
||||
(defun guix-ui-buffer-name-simple (base-name &rest _)
|
||||
"Return BASE-NAME."
|
||||
base-name)
|
||||
|
||||
(defun guix-ui-buffer-name-short (base-name profile)
|
||||
"Return buffer name by appending BASE-NAME and PROFILE's base file name."
|
||||
(guix-compose-buffer-name base-name
|
||||
(file-name-base (directory-file-name profile))))
|
||||
|
||||
(defun guix-ui-buffer-name-full (base-name profile)
|
||||
"Return buffer name by appending BASE-NAME and PROFILE's full name."
|
||||
(guix-compose-buffer-name base-name profile))
|
||||
|
||||
(defun guix-ui-buffer-name (base-name profile)
|
||||
"Return Guix buffer name based on BASE-NAME and profile.
|
||||
See `guix-ui-buffer-name-function' for details."
|
||||
(funcall guix-ui-buffer-name-function
|
||||
base-name profile))
|
||||
|
||||
(defun guix-ui-buffer? (&optional buffer modes)
|
||||
"Return non-nil if BUFFER mode is derived from any of the MODES.
|
||||
If BUFFER is nil, check current buffer.
|
||||
If MODES is nil, use `guix-list-mode' and `guix-info-mode'."
|
||||
(with-current-buffer (or buffer (current-buffer))
|
||||
(apply #'derived-mode-p
|
||||
(or modes '(guix-list-mode guix-info-mode)))))
|
||||
|
||||
(defun guix-ui-buffers (&optional modes)
|
||||
"Return a list of all buffers with major modes derived from MODES.
|
||||
If MODES is nil, return list of all Guix 'list' and 'info' buffers."
|
||||
(cl-remove-if-not (lambda (buf)
|
||||
(guix-ui-buffer? buf modes))
|
||||
(buffer-list)))
|
||||
|
||||
(defun guix-ui-update-buffer (buffer)
|
||||
"Update data in a 'list' or 'info' BUFFER."
|
||||
(with-current-buffer buffer
|
||||
(guix-buffer-revert nil t)))
|
||||
|
||||
(defun guix-ui-update-buffers-after-operation ()
|
||||
"Update buffers after Guix operation if needed.
|
||||
See `guix-ui-update-after-operation' for details."
|
||||
(let ((to-update
|
||||
(and guix-operation-buffer
|
||||
(cl-case guix-ui-update-after-operation
|
||||
(current (and (buffer-live-p guix-operation-buffer)
|
||||
(guix-ui-buffer? guix-operation-buffer)
|
||||
(list guix-operation-buffer)))
|
||||
(all (guix-ui-buffers))))))
|
||||
(setq guix-operation-buffer nil)
|
||||
(mapc #'guix-ui-update-buffer to-update)))
|
||||
|
||||
(add-hook 'guix-after-repl-operation-hook
|
||||
'guix-ui-update-buffers-after-operation)
|
||||
|
||||
|
||||
;;; Interface definers
|
||||
|
||||
(defmacro guix-ui-define-entry-type (entry-type &rest args)
|
||||
"Define general code for ENTRY-TYPE.
|
||||
Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
|
||||
|
||||
The rest keyword arguments are passed to
|
||||
`guix-define-entry-type' macro."
|
||||
(declare (indent 1))
|
||||
`(guix-define-entry-type ,entry-type
|
||||
:parent-group guix-ui
|
||||
:parent-faces-group guix-ui-faces
|
||||
,@args))
|
||||
|
||||
(defmacro guix-ui-define-interface (buffer-type entry-type &rest args)
|
||||
"Define BUFFER-TYPE interface for displaying ENTRY-TYPE entries.
|
||||
Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
|
||||
In the following description TYPE means ENTRY-TYPE-BUFFER-TYPE.
|
||||
|
||||
Required keywords:
|
||||
|
||||
- `:buffer-name' - base part of a buffer name. It is used in a
|
||||
generated `guix-TYPE-buffer-name' function; see
|
||||
`guix-ui-buffer-name' for details.
|
||||
|
||||
Optional keywords:
|
||||
|
||||
- `:required' - default value of the generated
|
||||
`guix-TYPE-required-params' variable.
|
||||
|
||||
The rest keyword arguments are passed to
|
||||
`guix-BUFFER-TYPE-define-interface' macro.
|
||||
|
||||
Along with the mentioned definitions, this macro also defines:
|
||||
|
||||
- `guix-TYPE-mode-map' - keymap based on `guix-ui-map' and
|
||||
`guix-BUFFER-TYPE-mode-map'.
|
||||
|
||||
- `guix-TYPE-get-entries' - a wrapper around `guix-ui-get-entries'.
|
||||
|
||||
- `guix-TYPE-message' - a wrapper around `guix-result-message'."
|
||||
(declare (indent 2))
|
||||
(let* ((entry-type-str (symbol-name entry-type))
|
||||
(buffer-type-str (symbol-name buffer-type))
|
||||
(prefix (concat "guix-" entry-type-str "-"
|
||||
buffer-type-str))
|
||||
(mode-str (concat prefix "-mode"))
|
||||
(mode-map (intern (concat mode-str "-map")))
|
||||
(parent-map (intern (format "guix-%s-mode-map"
|
||||
buffer-type-str)))
|
||||
(required-var (intern (concat prefix "-required-params")))
|
||||
(buffer-name-fun (intern (concat prefix "-buffer-name")))
|
||||
(get-fun (intern (concat prefix "-get-entries")))
|
||||
(message-fun (intern (concat prefix "-message")))
|
||||
(displayed-fun (intern (format "guix-%s-displayed-params"
|
||||
buffer-type-str)))
|
||||
(definer (intern (format "guix-%s-define-interface"
|
||||
buffer-type-str))))
|
||||
(guix-keyword-args-let args
|
||||
((buffer-name-val :buffer-name)
|
||||
(required-val :required ''(id)))
|
||||
`(progn
|
||||
(defvar ,mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent
|
||||
map (make-composed-keymap ,parent-map guix-ui-map))
|
||||
map)
|
||||
,(format "Keymap for `%s' buffers." mode-str))
|
||||
|
||||
(defvar ,required-var ,required-val
|
||||
,(format "\
|
||||
List of the required '%s' parameters.
|
||||
These parameters are received by `%S'
|
||||
along with the displayed parameters.
|
||||
|
||||
Do not remove `id' from this list as it is required for
|
||||
identifying an entry."
|
||||
entry-type-str get-fun))
|
||||
|
||||
(defun ,buffer-name-fun (profile &rest _)
|
||||
,(format "\
|
||||
Return a name of '%s' buffer for displaying '%s' entries.
|
||||
See `guix-ui-buffer-name' for details."
|
||||
buffer-type-str entry-type-str)
|
||||
(guix-ui-buffer-name ,buffer-name-val profile))
|
||||
|
||||
(defun ,get-fun (profile search-type &rest search-values)
|
||||
,(format "\
|
||||
Receive '%s' entries for displaying them in '%s' buffer.
|
||||
See `guix-ui-get-entries' for details."
|
||||
entry-type-str buffer-type-str)
|
||||
(guix-ui-get-entries
|
||||
profile ',entry-type search-type search-values
|
||||
(cl-union ,required-var
|
||||
(,displayed-fun ',entry-type))))
|
||||
|
||||
(defun ,message-fun (entries profile search-type
|
||||
&rest search-values)
|
||||
,(format "\
|
||||
Display a message after showing '%s' entries."
|
||||
entry-type-str)
|
||||
(guix-result-message
|
||||
profile entries ',entry-type search-type search-values))
|
||||
|
||||
(,definer ,entry-type
|
||||
:get-entries-function ',get-fun
|
||||
:message-function ',message-fun
|
||||
:buffer-name ',buffer-name-fun
|
||||
,@%foreign-args)))))
|
||||
|
||||
(defmacro guix-ui-info-define-interface (entry-type &rest args)
|
||||
"Define 'info' interface for displaying ENTRY-TYPE entries.
|
||||
See `guix-ui-define-interface'."
|
||||
(declare (indent 1))
|
||||
`(guix-ui-define-interface info ,entry-type
|
||||
,@args))
|
||||
|
||||
(defmacro guix-ui-list-define-interface (entry-type &rest args)
|
||||
"Define 'list' interface for displaying ENTRY-TYPE entries.
|
||||
Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
|
||||
|
||||
Optional keywords:
|
||||
|
||||
- `:describe-function' - default value of the generated
|
||||
`guix-ENTRY-TYPE-list-describe-function' variable (if not
|
||||
specified, use `guix-ui-list-describe').
|
||||
|
||||
The rest keyword arguments are passed to
|
||||
`guix-ui-define-interface' macro."
|
||||
(declare (indent 1))
|
||||
(guix-keyword-args-let args
|
||||
((describe-val :describe-function))
|
||||
`(guix-ui-define-interface list ,entry-type
|
||||
:describe-function ,(or describe-val ''guix-ui-list-describe)
|
||||
,@args)))
|
||||
|
||||
|
||||
(defvar guix-ui-font-lock-keywords
|
||||
(eval-when-compile
|
||||
`((,(rx "(" (group (or "guix-ui-define-entry-type"
|
||||
"guix-ui-define-interface"
|
||||
"guix-ui-info-define-interface"
|
||||
"guix-ui-list-define-interface"))
|
||||
symbol-end)
|
||||
. 1))))
|
||||
|
||||
(font-lock-add-keywords 'emacs-lisp-mode guix-ui-font-lock-keywords)
|
||||
|
||||
(provide 'guix-ui)
|
||||
|
||||
;;; guix-ui.el ends here
|
||||
@@ -1,609 +0,0 @@
|
||||
;;; guix-utils.el --- General utility functions -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides auxiliary general functions for guix.el package.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
|
||||
(defvar guix-true-string "Yes")
|
||||
(defvar guix-false-string "–")
|
||||
(defvar guix-list-separator ", ")
|
||||
|
||||
(defvar guix-time-format "%F %T"
|
||||
"String used to format time values.
|
||||
For possible formats, see `format-time-string'.")
|
||||
|
||||
(defun guix-get-string (val &optional face)
|
||||
"Convert VAL into a string and return it.
|
||||
|
||||
VAL can be an expression of any type.
|
||||
If VAL is t/nil, it is replaced with
|
||||
`guix-true-string'/`guix-false-string'.
|
||||
If VAL is list, its elements are concatenated using
|
||||
`guix-list-separator'.
|
||||
|
||||
If FACE is non-nil, propertize returned string with this FACE."
|
||||
(let ((str (cond
|
||||
((stringp val) val)
|
||||
((null val) guix-false-string)
|
||||
((eq t val) guix-true-string)
|
||||
((numberp val) (number-to-string val))
|
||||
((listp val) (mapconcat #'guix-get-string
|
||||
val guix-list-separator))
|
||||
(t (prin1-to-string val)))))
|
||||
(if (and val face)
|
||||
(propertize str 'font-lock-face face)
|
||||
str)))
|
||||
|
||||
(defun guix-get-time-string (seconds)
|
||||
"Return formatted time string from SECONDS.
|
||||
Use `guix-time-format'."
|
||||
(format-time-string guix-time-format (seconds-to-time seconds)))
|
||||
|
||||
(defun guix-get-one-line (str)
|
||||
"Return one-line string from a multi-line STR."
|
||||
(replace-regexp-in-string "\n" " " str))
|
||||
|
||||
(defmacro guix-with-indent (indent &rest body)
|
||||
"Evaluate BODY and indent inserted text by INDENT number of spaces."
|
||||
(declare (indent 1) (debug t))
|
||||
(let ((region-beg-var (make-symbol "region-beg"))
|
||||
(indent-var (make-symbol "indent")))
|
||||
`(let ((,region-beg-var (point))
|
||||
(,indent-var ,indent))
|
||||
,@body
|
||||
(unless (zerop ,indent-var)
|
||||
(indent-rigidly ,region-beg-var (point) ,indent-var)))))
|
||||
|
||||
(defun guix-format-insert (val &optional face format)
|
||||
"Convert VAL into a string and insert it at point.
|
||||
If FACE is non-nil, propertize VAL with FACE.
|
||||
If FORMAT is non-nil, format VAL with FORMAT."
|
||||
(let ((str (guix-get-string val face)))
|
||||
(insert (if format
|
||||
(format format str)
|
||||
str))))
|
||||
|
||||
(cl-defun guix-mapinsert (function sequence separator &key indent column)
|
||||
"Like `mapconcat' but for inserting text.
|
||||
Apply FUNCTION to each element of SEQUENCE, and insert SEPARATOR
|
||||
at point between each FUNCTION call.
|
||||
|
||||
If INDENT is non-nil, it should be a number of spaces used to
|
||||
indent each line of the inserted text.
|
||||
|
||||
If COLUMN is non-nil, it should be a column number which
|
||||
shouldn't be exceeded by the inserted text."
|
||||
(pcase sequence
|
||||
(`(,first . ,rest)
|
||||
(let* ((indent (or indent 0))
|
||||
(max-column (and column (- column indent))))
|
||||
(guix-with-indent indent
|
||||
(funcall function first)
|
||||
(dolist (element rest)
|
||||
(let ((before-sep-pos (and column (point))))
|
||||
(insert separator)
|
||||
(let ((after-sep-pos (and column (point))))
|
||||
(funcall function element)
|
||||
(when (and column
|
||||
(> (current-column) max-column))
|
||||
(save-excursion
|
||||
(delete-region before-sep-pos after-sep-pos)
|
||||
(goto-char before-sep-pos)
|
||||
(insert "\n")))))))))))
|
||||
|
||||
(defun guix-insert-button (label &optional type &rest properties)
|
||||
"Make button of TYPE with LABEL and insert it at point.
|
||||
See `insert-text-button' for the meaning of PROPERTIES."
|
||||
(if (null label)
|
||||
(guix-format-insert nil)
|
||||
(apply #'insert-text-button label
|
||||
:type (or type 'button)
|
||||
properties)))
|
||||
|
||||
(defun guix-buttonize (value button-type separator &rest properties)
|
||||
"Make BUTTON-TYPE button(s) from VALUE.
|
||||
Return a string with button(s).
|
||||
|
||||
VALUE should be a string or a list of strings. If it is a list
|
||||
of strings, buttons are separated with SEPARATOR string.
|
||||
|
||||
PROPERTIES are passed to `guix-insert-button'."
|
||||
(with-temp-buffer
|
||||
(let ((labels (if (listp value) value (list value))))
|
||||
(guix-mapinsert (lambda (label)
|
||||
(apply #'guix-insert-button
|
||||
label button-type properties))
|
||||
labels
|
||||
separator))
|
||||
(buffer-substring (point-min) (point-max))))
|
||||
|
||||
(defun guix-button-type? (symbol)
|
||||
"Return non-nil, if SYMBOL is a button type."
|
||||
(and symbol
|
||||
(get symbol 'button-category-symbol)))
|
||||
|
||||
(defun guix-split-insert (val &optional face col separator)
|
||||
"Convert VAL into a string, split it and insert at point.
|
||||
|
||||
If FACE is non-nil, propertize returned string with this FACE.
|
||||
|
||||
If COL is non-nil and result string is a one-line string longer
|
||||
than COL, split it into several short lines.
|
||||
|
||||
Separate inserted lines with SEPARATOR."
|
||||
(if (null val)
|
||||
(guix-format-insert nil)
|
||||
(let ((strings (guix-split-string (guix-get-string val) col)))
|
||||
(guix-mapinsert (lambda (str) (guix-format-insert str face))
|
||||
strings
|
||||
(or separator "")))))
|
||||
|
||||
(defun guix-split-string (str &optional col)
|
||||
"Split string STR by lines and return list of result strings.
|
||||
If COL is non-nil, fill STR to this column."
|
||||
(let ((str (if col
|
||||
(guix-get-filled-string str col)
|
||||
str)))
|
||||
(split-string str "\n *" t)))
|
||||
|
||||
(defun guix-get-filled-string (str col)
|
||||
"Return string by filling STR to column COL."
|
||||
(with-temp-buffer
|
||||
(insert str)
|
||||
(let ((fill-column col))
|
||||
(fill-region (point-min) (point-max)))
|
||||
(buffer-string)))
|
||||
|
||||
(defun guix-concat-strings (strings separator &optional location)
|
||||
"Return new string by concatenating STRINGS with SEPARATOR.
|
||||
If LOCATION is a symbol `head', add another SEPARATOR to the
|
||||
beginning of the returned string; if `tail' - add SEPARATOR to
|
||||
the end of the string; if nil, do not add SEPARATOR; otherwise
|
||||
add both to the end and to the beginning."
|
||||
(let ((str (mapconcat #'identity strings separator)))
|
||||
(cond ((null location)
|
||||
str)
|
||||
((eq location 'head)
|
||||
(concat separator str))
|
||||
((eq location 'tail)
|
||||
(concat str separator))
|
||||
(t
|
||||
(concat separator str separator)))))
|
||||
|
||||
(defun guix-hexify (value)
|
||||
"Convert VALUE to string and hexify it."
|
||||
(url-hexify-string (guix-get-string value)))
|
||||
|
||||
(defun guix-number->bool (number)
|
||||
"Convert NUMBER to boolean value.
|
||||
Return nil, if NUMBER is 0; return t otherwise."
|
||||
(not (zerop number)))
|
||||
|
||||
(defun guix-shell-quote-argument (argument)
|
||||
"Quote shell command ARGUMENT.
|
||||
This function is similar to `shell-quote-argument', but less strict."
|
||||
(if (equal argument "")
|
||||
"''"
|
||||
(replace-regexp-in-string
|
||||
"\n" "'\n'"
|
||||
(replace-regexp-in-string
|
||||
(rx (not (any alnum "-=,./\n"))) "\\\\\\&" argument))))
|
||||
|
||||
(defun guix-symbol-title (symbol)
|
||||
"Return SYMBOL's name, a string.
|
||||
This is like `symbol-name', but fancier."
|
||||
(if (eq symbol 'id)
|
||||
"ID"
|
||||
(let ((str (replace-regexp-in-string "-" " " (symbol-name symbol))))
|
||||
(concat (capitalize (substring str 0 1))
|
||||
(substring str 1)))))
|
||||
|
||||
(defun guix-command-symbol (&optional args)
|
||||
"Return symbol by concatenating 'guix' and ARGS (strings)."
|
||||
(intern (guix-concat-strings (cons "guix" args) "-")))
|
||||
|
||||
(defun guix-command-string (&optional args)
|
||||
"Return 'guix ARGS ...' string with quoted shell arguments."
|
||||
(let ((args (mapcar #'guix-shell-quote-argument args)))
|
||||
(guix-concat-strings (cons "guix" args) " ")))
|
||||
|
||||
(defun guix-copy-as-kill (string &optional no-message?)
|
||||
"Put STRING into `kill-ring'.
|
||||
If NO-MESSAGE? is non-nil, do not display a message about it."
|
||||
(kill-new string)
|
||||
(unless no-message?
|
||||
(message "'%s' has been added to kill ring." string)))
|
||||
|
||||
(defun guix-copy-command-as-kill (args &optional no-message?)
|
||||
"Put 'guix ARGS ...' string into `kill-ring'.
|
||||
See also `guix-copy-as-kill'."
|
||||
(guix-copy-as-kill (guix-command-string args) no-message?))
|
||||
|
||||
(defun guix-compose-buffer-name (base-name postfix)
|
||||
"Return buffer name by appending BASE-NAME and POSTFIX.
|
||||
|
||||
In a simple case the result is:
|
||||
|
||||
BASE-NAME: POSTFIX
|
||||
|
||||
If BASE-NAME is wrapped by '*', then the result is:
|
||||
|
||||
*BASE-NAME: POSTFIX*"
|
||||
(let ((re (rx string-start
|
||||
(group (? "*"))
|
||||
(group (*? any))
|
||||
(group (? "*"))
|
||||
string-end)))
|
||||
(or (string-match re base-name)
|
||||
(error "Unexpected error in defining buffer name"))
|
||||
(let ((first* (match-string 1 base-name))
|
||||
(name-body (match-string 2 base-name))
|
||||
(last* (match-string 3 base-name)))
|
||||
;; Handle the case when buffer name is wrapped by '*'.
|
||||
(if (and (string= "*" first*)
|
||||
(string= "*" last*))
|
||||
(concat "*" name-body ": " postfix "*")
|
||||
(concat base-name ": " postfix)))))
|
||||
|
||||
(defun guix-completing-read (prompt table &optional predicate
|
||||
require-match initial-input
|
||||
hist def inherit-input-method)
|
||||
"Same as `completing-read' but return nil instead of an empty string."
|
||||
(let ((res (completing-read prompt table predicate
|
||||
require-match initial-input
|
||||
hist def inherit-input-method)))
|
||||
(unless (string= "" res) res)))
|
||||
|
||||
(defun guix-completing-read-multiple (prompt table &optional predicate
|
||||
require-match initial-input
|
||||
hist def inherit-input-method)
|
||||
"Same as `completing-read-multiple' but remove duplicates in result."
|
||||
(cl-remove-duplicates
|
||||
(completing-read-multiple prompt table predicate
|
||||
require-match initial-input
|
||||
hist def inherit-input-method)
|
||||
:test #'string=))
|
||||
|
||||
(declare-function org-read-date "org" t)
|
||||
|
||||
(defun guix-read-date (prompt)
|
||||
"Prompt for a date or time using `org-read-date'.
|
||||
Return time value."
|
||||
(require 'org)
|
||||
(org-read-date nil t nil prompt))
|
||||
|
||||
(defun guix-read-file-name (prompt &optional dir default-filename
|
||||
mustmatch initial predicate)
|
||||
"Read file name.
|
||||
This function is similar to `read-file-name' except it also
|
||||
expands the file name."
|
||||
(expand-file-name (read-file-name prompt dir default-filename
|
||||
mustmatch initial predicate)))
|
||||
|
||||
(defcustom guix-find-file-function #'find-file
|
||||
"Function used to find a file.
|
||||
The function is called by `guix-find-file' with a file name as a
|
||||
single argument."
|
||||
:type '(choice (function-item find-file)
|
||||
(function-item org-open-file)
|
||||
(function :tag "Other function"))
|
||||
:group 'guix)
|
||||
|
||||
(defun guix-find-file (file)
|
||||
"Find FILE if it exists."
|
||||
(if (file-exists-p file)
|
||||
(funcall guix-find-file-function file)
|
||||
(message "File '%s' does not exist." file)))
|
||||
|
||||
(defvar url-handler-regexp)
|
||||
|
||||
(defun guix-find-file-or-url (file-or-url)
|
||||
"Find FILE-OR-URL."
|
||||
(require 'url-handlers)
|
||||
(let ((file-name-handler-alist
|
||||
(cons (cons url-handler-regexp 'url-file-handler)
|
||||
file-name-handler-alist)))
|
||||
(find-file file-or-url)))
|
||||
|
||||
(defmacro guix-while-search (regexp &rest body)
|
||||
"Evaluate BODY after each search for REGEXP in the current buffer."
|
||||
(declare (indent 1) (debug t))
|
||||
`(save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward ,regexp nil t)
|
||||
,@body)))
|
||||
|
||||
(defmacro guix-while-null (&rest body)
|
||||
"Evaluate BODY until its result becomes non-nil."
|
||||
(declare (indent 0) (debug t))
|
||||
(let ((result-var (make-symbol "result")))
|
||||
`(let (,result-var)
|
||||
(while (null ,result-var)
|
||||
(setq ,result-var ,@body))
|
||||
,result-var)))
|
||||
|
||||
(defun guix-modify (object modifiers)
|
||||
"Apply MODIFIERS to OBJECT.
|
||||
OBJECT is passed as an argument to the first function from
|
||||
MODIFIERS list, the returned result is passed to the second
|
||||
function from the list and so on. Return result of the last
|
||||
modifier call."
|
||||
(if (null modifiers)
|
||||
object
|
||||
(guix-modify (funcall (car modifiers) object)
|
||||
(cdr modifiers))))
|
||||
|
||||
(defmacro guix-keyword-args-let (args varlist &rest body)
|
||||
"Parse ARGS, bind variables from VARLIST and eval BODY.
|
||||
|
||||
Find keyword values in ARGS, bind them to variables according to
|
||||
VARLIST, then evaluate BODY.
|
||||
|
||||
ARGS is a keyword/value property list.
|
||||
|
||||
Each element of VARLIST has a form:
|
||||
|
||||
(SYMBOL KEYWORD [DEFAULT-VALUE])
|
||||
|
||||
SYMBOL is a varible name. KEYWORD is a symbol that will be
|
||||
searched in ARGS for an according value. If the value of KEYWORD
|
||||
does not exist, bind SYMBOL to DEFAULT-VALUE or nil.
|
||||
|
||||
The rest arguments (that present in ARGS but not in VARLIST) will
|
||||
be bound to `%foreign-args' variable.
|
||||
|
||||
Example:
|
||||
|
||||
(guix-keyword-args-let '(:two 8 :great ! :guix is)
|
||||
((one :one 1)
|
||||
(two :two 2)
|
||||
(foo :smth))
|
||||
(list one two foo %foreign-args))
|
||||
|
||||
=> (1 8 nil (:guix is :great !))"
|
||||
(declare (indent 2))
|
||||
(let ((args-var (make-symbol "args")))
|
||||
`(let (,@(mapcar (lambda (spec)
|
||||
(pcase-let ((`(,name ,_ ,val) spec))
|
||||
(list name val)))
|
||||
varlist)
|
||||
(,args-var ,args)
|
||||
%foreign-args)
|
||||
(while ,args-var
|
||||
(pcase ,args-var
|
||||
(`(,key ,val . ,rest-args)
|
||||
(cl-case key
|
||||
,@(mapcar (lambda (spec)
|
||||
(pcase-let ((`(,name ,key ,_) spec))
|
||||
`(,key (setq ,name val))))
|
||||
varlist)
|
||||
(t (setq %foreign-args
|
||||
(cl-list* key val %foreign-args))))
|
||||
(setq ,args-var rest-args))))
|
||||
,@body)))
|
||||
|
||||
|
||||
;;; Alist procedures
|
||||
|
||||
(defmacro guix-define-alist-accessor (name assoc-fun)
|
||||
"Define NAME function to access alist values using ASSOC-FUN."
|
||||
`(defun ,name (alist &rest keys)
|
||||
,(format "Return value from ALIST by KEYS using `%s'.
|
||||
ALIST is alist of alists of alists ... which can be consecutively
|
||||
accessed with KEYS."
|
||||
assoc-fun)
|
||||
(if (or (null alist) (null keys))
|
||||
alist
|
||||
(apply #',name
|
||||
(cdr (,assoc-fun (car keys) alist))
|
||||
(cdr keys)))))
|
||||
|
||||
(guix-define-alist-accessor guix-assq-value assq)
|
||||
(guix-define-alist-accessor guix-assoc-value assoc)
|
||||
|
||||
(defun guix-alist-put (value alist &rest keys)
|
||||
"Put (add or replace if exists) VALUE to ALIST using KEYS.
|
||||
Return the new alist.
|
||||
|
||||
ALIST is alist of alists of alists ... which can be consecutively
|
||||
accessed with KEYS.
|
||||
|
||||
Example:
|
||||
|
||||
(guix-alist-put
|
||||
'foo
|
||||
'((one (a . 1) (b . 2))
|
||||
(two (m . 7) (n . 8)))
|
||||
'one 'b)
|
||||
|
||||
=> ((one (a . 1) (b . foo))
|
||||
(two (m . 7) (n . 8)))"
|
||||
(or keys (error "Keys should be specified"))
|
||||
(guix-alist-put-1 value alist keys))
|
||||
|
||||
(defun guix-alist-put-1 (value alist keys)
|
||||
"Subroutine of `guix-alist-put'."
|
||||
(cond
|
||||
((null keys)
|
||||
value)
|
||||
((null alist)
|
||||
(list (cons (car keys)
|
||||
(guix-alist-put-1 value nil (cdr keys)))))
|
||||
((eq (car keys) (caar alist))
|
||||
(cons (cons (car keys)
|
||||
(guix-alist-put-1 value (cdar alist) (cdr keys)))
|
||||
(cdr alist)))
|
||||
(t
|
||||
(cons (car alist)
|
||||
(guix-alist-put-1 value (cdr alist) keys)))))
|
||||
|
||||
(defun guix-alist-put! (value variable &rest keys)
|
||||
"Modify alist VARIABLE (symbol) by putting VALUE using KEYS.
|
||||
See `guix-alist-put' for details."
|
||||
(set variable
|
||||
(apply #'guix-alist-put value (symbol-value variable) keys)))
|
||||
|
||||
|
||||
;;; Diff
|
||||
|
||||
(defvar guix-diff-switches "-u"
|
||||
"A string or list of strings specifying switches to be passed to diff.")
|
||||
|
||||
(defun guix-diff (old new &optional switches no-async)
|
||||
"Same as `diff', but use `guix-diff-switches' as default."
|
||||
(diff old new (or switches guix-diff-switches) no-async))
|
||||
|
||||
|
||||
;;; Completing readers definers
|
||||
|
||||
(defmacro guix-define-reader (name read-fun completions prompt)
|
||||
"Define NAME function to read from minibuffer.
|
||||
READ-FUN may be `completing-read', `completing-read-multiple' or
|
||||
another function with the same arguments."
|
||||
`(defun ,name (&optional prompt initial-contents)
|
||||
(,read-fun ,(if prompt
|
||||
`(or prompt ,prompt)
|
||||
'prompt)
|
||||
,completions nil nil initial-contents)))
|
||||
|
||||
(defmacro guix-define-readers (&rest args)
|
||||
"Define reader functions.
|
||||
|
||||
ARGS should have a form [KEYWORD VALUE] ... The following
|
||||
keywords are available:
|
||||
|
||||
- `completions-var' - variable used to get completions.
|
||||
|
||||
- `completions-getter' - function used to get completions.
|
||||
|
||||
- `single-reader', `single-prompt' - name of a function to read
|
||||
a single value, and a prompt for it.
|
||||
|
||||
- `multiple-reader', `multiple-prompt' - name of a function to
|
||||
read multiple values, and a prompt for it.
|
||||
|
||||
- `multiple-separator' - if specified, another
|
||||
`<multiple-reader-name>-string' function returning a string
|
||||
of multiple values separated the specified separator will be
|
||||
defined."
|
||||
(guix-keyword-args-let args
|
||||
((completions-var :completions-var)
|
||||
(completions-getter :completions-getter)
|
||||
(single-reader :single-reader)
|
||||
(single-prompt :single-prompt)
|
||||
(multiple-reader :multiple-reader)
|
||||
(multiple-prompt :multiple-prompt)
|
||||
(multiple-separator :multiple-separator))
|
||||
(let ((completions
|
||||
(cond ((and completions-var completions-getter)
|
||||
`(or ,completions-var
|
||||
(setq ,completions-var
|
||||
(funcall ',completions-getter))))
|
||||
(completions-var
|
||||
completions-var)
|
||||
(completions-getter
|
||||
`(funcall ',completions-getter)))))
|
||||
`(progn
|
||||
,(when (and completions-var
|
||||
(not (boundp completions-var)))
|
||||
`(defvar ,completions-var nil))
|
||||
|
||||
,(when single-reader
|
||||
`(guix-define-reader ,single-reader guix-completing-read
|
||||
,completions ,single-prompt))
|
||||
|
||||
,(when multiple-reader
|
||||
`(guix-define-reader ,multiple-reader completing-read-multiple
|
||||
,completions ,multiple-prompt))
|
||||
|
||||
,(when (and multiple-reader multiple-separator)
|
||||
(let ((name (intern (concat (symbol-name multiple-reader)
|
||||
"-string"))))
|
||||
`(defun ,name (&optional prompt initial-contents)
|
||||
(guix-concat-strings
|
||||
(,multiple-reader prompt initial-contents)
|
||||
,multiple-separator))))))))
|
||||
|
||||
|
||||
;;; Memoizing
|
||||
|
||||
(defun guix-memoize (function)
|
||||
"Return a memoized version of FUNCTION."
|
||||
(let ((cache (make-hash-table :test 'equal)))
|
||||
(lambda (&rest args)
|
||||
(let ((result (gethash args cache 'not-found)))
|
||||
(if (eq result 'not-found)
|
||||
(let ((result (apply function args)))
|
||||
(puthash args result cache)
|
||||
result)
|
||||
result)))))
|
||||
|
||||
(defmacro guix-memoized-defun (name arglist docstring &rest body)
|
||||
"Define a memoized function NAME.
|
||||
See `defun' for the meaning of arguments."
|
||||
(declare (doc-string 3) (indent 2))
|
||||
`(defalias ',name
|
||||
(guix-memoize (lambda ,arglist ,@body))
|
||||
;; Add '(name args ...)' string with real arglist to the docstring,
|
||||
;; because *Help* will display '(name &rest ARGS)' for a defined
|
||||
;; function (since `guix-memoize' returns a lambda with '(&rest
|
||||
;; args)').
|
||||
,(format "(%S %s)\n\n%s"
|
||||
name
|
||||
(mapconcat #'symbol-name arglist " ")
|
||||
docstring)))
|
||||
|
||||
(defmacro guix-memoized-defalias (symbol definition &optional docstring)
|
||||
"Set SYMBOL's function definition to memoized version of DEFINITION."
|
||||
(declare (doc-string 3) (indent 1))
|
||||
`(defalias ',symbol
|
||||
(guix-memoize #',definition)
|
||||
,(or docstring
|
||||
(format "Memoized version of `%S'." definition))))
|
||||
|
||||
|
||||
(defvar guix-utils-font-lock-keywords
|
||||
(eval-when-compile
|
||||
`((,(rx "(" (group (or "guix-define-reader"
|
||||
"guix-define-readers"
|
||||
"guix-keyword-args-let"
|
||||
"guix-while-null"
|
||||
"guix-while-search"
|
||||
"guix-with-indent"))
|
||||
symbol-end)
|
||||
. 1)
|
||||
(,(rx "("
|
||||
(group "guix-memoized-" (or "defun" "defalias"))
|
||||
symbol-end
|
||||
(zero-or-more blank)
|
||||
(zero-or-one
|
||||
(group (one-or-more (or (syntax word) (syntax symbol))))))
|
||||
(1 font-lock-keyword-face)
|
||||
(2 font-lock-function-name-face nil t)))))
|
||||
|
||||
(font-lock-add-keywords 'emacs-lisp-mode guix-utils-font-lock-keywords)
|
||||
|
||||
(provide 'guix-utils)
|
||||
|
||||
;;; guix-utils.el ends here
|
||||
@@ -1,77 +0,0 @@
|
||||
# GNU Guix --- Functional package management for GNU
|
||||
# Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com>
|
||||
# Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
|
||||
#
|
||||
# This file is part of GNU Guix.
|
||||
#
|
||||
# GNU Guix is free software; you can redistribute it and/or modify it
|
||||
# under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 3 of the License, or (at
|
||||
# your option) any later version.
|
||||
#
|
||||
# GNU Guix is distributed in the hope that it will be useful, but
|
||||
# WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
AUTOLOADS = %D%/guix-autoloads.el
|
||||
|
||||
ELFILES = \
|
||||
%D%/guix-about.el \
|
||||
%D%/guix-backend.el \
|
||||
%D%/guix-base.el \
|
||||
%D%/guix-build-log.el \
|
||||
%D%/guix-buffer.el \
|
||||
%D%/guix-command.el \
|
||||
%D%/guix-devel.el \
|
||||
%D%/guix-emacs.el \
|
||||
%D%/guix-entry.el \
|
||||
%D%/guix-external.el \
|
||||
%D%/guix-geiser.el \
|
||||
%D%/guix-guile.el \
|
||||
%D%/guix-help-vars.el \
|
||||
%D%/guix-history.el \
|
||||
%D%/guix-hydra.el \
|
||||
%D%/guix-hydra-build.el \
|
||||
%D%/guix-hydra-jobset.el \
|
||||
%D%/guix-info.el \
|
||||
%D%/guix-init.el \
|
||||
%D%/guix-license.el \
|
||||
%D%/guix-list.el \
|
||||
%D%/guix-location.el \
|
||||
%D%/guix-messages.el \
|
||||
%D%/guix-pcomplete.el \
|
||||
%D%/guix-popup.el \
|
||||
%D%/guix-prettify.el \
|
||||
%D%/guix-profiles.el \
|
||||
%D%/guix-read.el \
|
||||
%D%/guix-ui.el \
|
||||
%D%/guix-ui-license.el \
|
||||
%D%/guix-ui-location.el \
|
||||
%D%/guix-ui-package.el \
|
||||
%D%/guix-ui-generation.el \
|
||||
%D%/guix-ui-system-generation.el \
|
||||
%D%/guix-utils.el
|
||||
|
||||
if HAVE_EMACS
|
||||
|
||||
dist_lisp_DATA = $(ELFILES)
|
||||
|
||||
nodist_lisp_DATA = \
|
||||
%D%/guix-config.el \
|
||||
$(AUTOLOADS)
|
||||
|
||||
$(AUTOLOADS): $(ELFILES)
|
||||
$(AM_V_EMACS)$(EMACS) --batch --eval \
|
||||
"(let ((backup-inhibited t) \
|
||||
(generated-autoload-file \
|
||||
(expand-file-name \"$(AUTOLOADS)\" \"$(builddir)\"))) \
|
||||
(update-directory-autoloads \
|
||||
(expand-file-name \"emacs\" \"$(srcdir)\")))"
|
||||
|
||||
CLEANFILES += $(AUTOLOADS)
|
||||
|
||||
endif HAVE_EMACS
|
||||
Executable
+57
@@ -0,0 +1,57 @@
|
||||
#!/bin/sh
|
||||
|
||||
# This hook script prevents the user from pushing to Savannah if any of the new
|
||||
# commits' OpenPGP signatures cannot be verified.
|
||||
|
||||
# Called by "git push" after it has checked the remote status, but before
|
||||
# anything has been pushed. If this script exits with a non-zero status nothing
|
||||
# will be pushed.
|
||||
#
|
||||
# This hook is called with the following parameters:
|
||||
#
|
||||
# $1 -- Name of the remote to which the push is being done
|
||||
# $2 -- URL to which the push is being done
|
||||
#
|
||||
# If pushing without using a named remote those arguments will be equal.
|
||||
#
|
||||
# Information about the commits which are being pushed is supplied as lines to
|
||||
# the standard input in the form:
|
||||
#
|
||||
# <local ref> <local sha1> <remote ref> <remote sha1>
|
||||
|
||||
z40=0000000000000000000000000000000000000000
|
||||
|
||||
# Only use the hook when pushing to Savannah.
|
||||
case "$2" in
|
||||
*git.sv.gnu.org*)
|
||||
break
|
||||
;;
|
||||
*)
|
||||
exit 0
|
||||
;;
|
||||
esac
|
||||
|
||||
while read local_ref local_sha remote_ref remote_sha
|
||||
do
|
||||
if [ "$local_sha" = $z40 ]
|
||||
then
|
||||
# Handle delete
|
||||
:
|
||||
else
|
||||
if [ "$remote_sha" = $z40 ]
|
||||
then
|
||||
# New branch, examine all commits
|
||||
range="$local_sha"
|
||||
else
|
||||
# Update to existing branch, examine new commits
|
||||
range="$remote_sha..$local_sha"
|
||||
fi
|
||||
|
||||
# Verify the signatures of all commits being pushed.
|
||||
git verify-commit $(git rev-list $range) >/dev/null 2>&1
|
||||
|
||||
exit $?
|
||||
fi
|
||||
done
|
||||
|
||||
exit 0
|
||||
+187
-125
@@ -1,5 +1,6 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2016, 2017 David Craven <david@craven.ch>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -71,67 +72,114 @@
|
||||
"Bind-mount SOURCE at TARGET."
|
||||
(mount source target "" MS_BIND))
|
||||
|
||||
(define (read-superblock device offset size magic?)
|
||||
"Read a superblock of SIZE from OFFSET and DEVICE. Return the raw
|
||||
superblock on success, and #f if no valid superblock was found. MAGIC?
|
||||
takes a bytevector and returns #t when it's a valid superblock."
|
||||
(call-with-input-file device
|
||||
(lambda (port)
|
||||
(seek port offset SEEK_SET)
|
||||
|
||||
(let ((block (make-bytevector size)))
|
||||
(match (get-bytevector-n! port block 0 (bytevector-length block))
|
||||
((? eof-object?)
|
||||
#f)
|
||||
((? number? len)
|
||||
(and (= len (bytevector-length block))
|
||||
(and (magic? block)
|
||||
block))))))))
|
||||
|
||||
(define (sub-bytevector bv start size)
|
||||
"Return a copy of the SIZE bytes of BV starting from offset START."
|
||||
(let ((result (make-bytevector size)))
|
||||
(bytevector-copy! bv start result 0 size)
|
||||
result))
|
||||
|
||||
(define (null-terminated-latin1->string bv)
|
||||
"Return the volume name of SBLOCK as a string of at most 256 characters, or
|
||||
#f if SBLOCK has no volume name."
|
||||
;; This is a Latin-1, nul-terminated string.
|
||||
(let ((bytes (take-while (negate zero?) (bytevector->u8-list bv))))
|
||||
(if (null? bytes)
|
||||
#f
|
||||
(list->string (map integer->char bytes)))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Ext2 file systems.
|
||||
;;;
|
||||
|
||||
;; <http://www.nongnu.org/ext2-doc/ext2.html#DEF-SUPERBLOCK>.
|
||||
;; TODO: Use "packed structs" from Guile-OpenGL or similar.
|
||||
|
||||
(define-syntax %ext2-endianness
|
||||
;; Endianness of ext2 file systems.
|
||||
(identifier-syntax (endianness little)))
|
||||
|
||||
;; Offset in bytes of interesting parts of an ext2 superblock. See
|
||||
;; <http://www.nongnu.org/ext2-doc/ext2.html#DEF-SUPERBLOCK>.
|
||||
;; TODO: Use "packed structs" from Guile-OpenGL or similar.
|
||||
(define-syntax %ext2-sblock-magic (identifier-syntax 56))
|
||||
(define-syntax %ext2-sblock-creator-os (identifier-syntax 72))
|
||||
(define-syntax %ext2-sblock-uuid (identifier-syntax 104))
|
||||
(define-syntax %ext2-sblock-volume-name (identifier-syntax 120))
|
||||
(define (ext2-superblock? sblock)
|
||||
"Return #t when SBLOCK is an ext2 superblock."
|
||||
(let ((magic (bytevector-u16-ref sblock 56 %ext2-endianness)))
|
||||
(= magic #xef53)))
|
||||
|
||||
(define (read-ext2-superblock device)
|
||||
"Return the raw contents of DEVICE's ext2 superblock as a bytevector, or #f
|
||||
if DEVICE does not contain an ext2 file system."
|
||||
(define %ext2-magic
|
||||
;; The magic bytes that identify an ext2 file system.
|
||||
#xef53)
|
||||
|
||||
(define superblock-size
|
||||
;; Size of the interesting part of an ext2 superblock.
|
||||
264)
|
||||
|
||||
(define block
|
||||
;; The superblock contents.
|
||||
(make-bytevector superblock-size))
|
||||
|
||||
(call-with-input-file device
|
||||
(lambda (port)
|
||||
(seek port 1024 SEEK_SET)
|
||||
|
||||
;; Note: work around <http://bugs.gnu.org/17466>.
|
||||
(and (eqv? superblock-size (get-bytevector-n! port block 0
|
||||
superblock-size))
|
||||
(let ((magic (bytevector-u16-ref block %ext2-sblock-magic
|
||||
%ext2-endianness)))
|
||||
(and (= magic %ext2-magic)
|
||||
block))))))
|
||||
(read-superblock device 1024 264 ext2-superblock?))
|
||||
|
||||
(define (ext2-superblock-uuid sblock)
|
||||
"Return the UUID of ext2 superblock SBLOCK as a 16-byte bytevector."
|
||||
(let ((uuid (make-bytevector 16)))
|
||||
(bytevector-copy! sblock %ext2-sblock-uuid uuid 0 16)
|
||||
uuid))
|
||||
(sub-bytevector sblock 104 16))
|
||||
|
||||
(define (ext2-superblock-volume-name sblock)
|
||||
"Return the volume name of SBLOCK as a string of at most 16 characters, or
|
||||
#f if SBLOCK has no volume name."
|
||||
(let ((bv (make-bytevector 16)))
|
||||
(bytevector-copy! sblock %ext2-sblock-volume-name bv 0 16)
|
||||
(null-terminated-latin1->string (sub-bytevector sblock 120 16)))
|
||||
|
||||
;; This is a Latin-1, nul-terminated string.
|
||||
(let ((bytes (take-while (negate zero?) (bytevector->u8-list bv))))
|
||||
(if (null? bytes)
|
||||
#f
|
||||
(list->string (map integer->char bytes))))))
|
||||
(define (check-ext2-file-system device)
|
||||
"Return the health of an ext2 file system on DEVICE."
|
||||
(match (status:exit-val
|
||||
(system* "e2fsck" "-v" "-p" "-C" "0" device))
|
||||
(0 'pass)
|
||||
(1 'errors-corrected)
|
||||
(2 'reboot-required)
|
||||
(_ 'fatal-error)))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Btrfs file systems.
|
||||
;;;
|
||||
|
||||
;; <https://btrfs.wiki.kernel.org/index.php/On-disk_Format#Superblock>.
|
||||
|
||||
(define-syntax %btrfs-endianness
|
||||
;; Endianness of btrfs file systems.
|
||||
(identifier-syntax (endianness little)))
|
||||
|
||||
(define (btrfs-superblock? sblock)
|
||||
"Return #t when SBLOCK is a btrfs superblock."
|
||||
(bytevector=? (sub-bytevector sblock 64 8)
|
||||
(string->utf8 "_BHRfS_M")))
|
||||
|
||||
(define (read-btrfs-superblock device)
|
||||
"Return the raw contents of DEVICE's btrfs superblock as a bytevector, or #f
|
||||
if DEVICE does not contain a btrfs file system."
|
||||
(read-superblock device 65536 4096 btrfs-superblock?))
|
||||
|
||||
(define (btrfs-superblock-uuid sblock)
|
||||
"Return the UUID of a btrfs superblock SBLOCK as a 16-byte bytevector."
|
||||
(sub-bytevector sblock 32 16))
|
||||
|
||||
(define (btrfs-superblock-volume-name sblock)
|
||||
"Return the volume name of SBLOCK as a string of at most 256 characters, or
|
||||
#f if SBLOCK has no volume name."
|
||||
(null-terminated-latin1->string (sub-bytevector sblock 299 256)))
|
||||
|
||||
(define (check-btrfs-file-system device)
|
||||
"Return the health of a btrfs file system on DEVICE."
|
||||
(match (status:exit-val
|
||||
(system* "btrfs" "device" "scan"))
|
||||
(0 'pass)
|
||||
(_ 'fatal-error)))
|
||||
|
||||
|
||||
;;;
|
||||
@@ -146,37 +194,22 @@ if DEVICE does not contain an ext2 file system."
|
||||
;; Endianness of LUKS headers.
|
||||
(identifier-syntax (endianness big)))
|
||||
|
||||
(define-syntax %luks-header-size
|
||||
;; Size in bytes of the LUKS header, including key slots.
|
||||
(identifier-syntax 592))
|
||||
|
||||
(define %luks-magic
|
||||
;; The 'LUKS_MAGIC' constant.
|
||||
(u8-list->bytevector (append (map char->integer (string->list "LUKS"))
|
||||
(list #xba #xbe))))
|
||||
|
||||
(define (sub-bytevector bv start size)
|
||||
"Return a copy of the SIZE bytes of BV starting from offset START."
|
||||
(let ((result (make-bytevector size)))
|
||||
(bytevector-copy! bv start result 0 size)
|
||||
result))
|
||||
(define (luks-superblock? sblock)
|
||||
"Return #t when SBLOCK is a luks superblock."
|
||||
(define %luks-magic
|
||||
;; The 'LUKS_MAGIC' constant.
|
||||
(u8-list->bytevector (append (map char->integer (string->list "LUKS"))
|
||||
(list #xba #xbe))))
|
||||
(let ((magic (sub-bytevector sblock 0 6))
|
||||
(version (bytevector-u16-ref sblock 6 %luks-endianness)))
|
||||
(and (bytevector=? magic %luks-magic)
|
||||
(= version 1))))
|
||||
|
||||
(define (read-luks-header file)
|
||||
"Read a LUKS header from FILE. Return the raw header on success, and #f if
|
||||
not valid header was found."
|
||||
(call-with-input-file file
|
||||
(lambda (port)
|
||||
(let ((header (make-bytevector %luks-header-size)))
|
||||
(match (get-bytevector-n! port header 0 (bytevector-length header))
|
||||
((? eof-object?)
|
||||
#f)
|
||||
((? number? len)
|
||||
(and (= len (bytevector-length header))
|
||||
(let ((magic (sub-bytevector header 0 6)) ;XXX: inefficient
|
||||
(version (bytevector-u16-ref header 6 %luks-endianness)))
|
||||
(and (bytevector=? magic %luks-magic)
|
||||
(= version 1)
|
||||
header)))))))))
|
||||
;; Size in bytes of the LUKS header, including key slots.
|
||||
(read-superblock file 0 592 luks-superblock?))
|
||||
|
||||
(define (luks-header-uuid header)
|
||||
"Return the LUKS UUID from HEADER, as a 16-byte bytevector."
|
||||
@@ -242,56 +275,77 @@ warning and #f as the result."
|
||||
(else
|
||||
(apply throw args))))))))
|
||||
|
||||
(define (partition-predicate read field =)
|
||||
(define (partition-field-reader read field)
|
||||
"Return a procedure that takes a device and returns the value of a FIELD in
|
||||
the partition superblock or #f."
|
||||
(let ((read (ENOENT-safe read)))
|
||||
(lambda (device)
|
||||
(let ((sblock (read device)))
|
||||
(and sblock
|
||||
(field sblock))))))
|
||||
|
||||
(define (read-partition-field device partition-field-readers)
|
||||
"Returns the value of a FIELD in the partition superblock of DEVICE or #f. It
|
||||
takes a list of PARTITION-FIELD-READERS and returns the result of the first
|
||||
partition field reader that returned a value."
|
||||
(match (filter-map (cut apply <> (list device)) partition-field-readers)
|
||||
((field . _) field)
|
||||
(_ #f)))
|
||||
|
||||
(define %partition-label-readers
|
||||
(list (partition-field-reader read-ext2-superblock
|
||||
ext2-superblock-volume-name)
|
||||
(partition-field-reader read-btrfs-superblock
|
||||
btrfs-superblock-volume-name)))
|
||||
|
||||
(define %partition-uuid-readers
|
||||
(list (partition-field-reader read-ext2-superblock
|
||||
ext2-superblock-uuid)
|
||||
(partition-field-reader read-btrfs-superblock
|
||||
btrfs-superblock-uuid)))
|
||||
|
||||
(define read-partition-label
|
||||
(cut read-partition-field <> %partition-label-readers))
|
||||
|
||||
(define read-partition-uuid
|
||||
(cut read-partition-field <> %partition-uuid-readers))
|
||||
|
||||
(define (partition-predicate reader =)
|
||||
"Return a predicate that returns true if the FIELD of partition header that
|
||||
was READ is = to the given value."
|
||||
(let ((read (ENOENT-safe read)))
|
||||
(lambda (expected)
|
||||
"Return a procedure that, when applied to a partition name such as \"sda1\",
|
||||
returns #t if that partition's volume name is LABEL."
|
||||
(lambda (part)
|
||||
(let* ((device (string-append "/dev/" part))
|
||||
(sblock (read device)))
|
||||
(and sblock
|
||||
(let ((actual (field sblock)))
|
||||
(and actual
|
||||
(= actual expected)))))))))
|
||||
(lambda (expected)
|
||||
(lambda (device)
|
||||
(let ((actual (reader device)))
|
||||
(and actual
|
||||
(= actual expected))))))
|
||||
|
||||
(define partition-label-predicate
|
||||
(partition-predicate read-ext2-superblock
|
||||
ext2-superblock-volume-name
|
||||
string=?))
|
||||
(partition-predicate read-partition-label string=?))
|
||||
|
||||
(define partition-uuid-predicate
|
||||
(partition-predicate read-ext2-superblock
|
||||
ext2-superblock-uuid
|
||||
bytevector=?))
|
||||
(partition-predicate read-partition-uuid bytevector=?))
|
||||
|
||||
(define partition-luks-uuid-predicate
|
||||
(partition-predicate read-luks-header
|
||||
luks-header-uuid
|
||||
bytevector=?))
|
||||
(define luks-partition-uuid-predicate
|
||||
(partition-predicate
|
||||
(partition-field-reader read-luks-header luks-header-uuid)
|
||||
bytevector=?))
|
||||
|
||||
(define (find-partition-by-label label)
|
||||
"Return the first partition found whose volume name is LABEL, or #f if none
|
||||
(define (find-partition predicate)
|
||||
"Return the first partition found that matches PREDICATE, or #f if none
|
||||
were found."
|
||||
(and=> (find (partition-label-predicate label)
|
||||
(disk-partitions))
|
||||
(cut string-append "/dev/" <>)))
|
||||
(lambda (expected)
|
||||
(find (predicate expected)
|
||||
(map (cut string-append "/dev/" <>)
|
||||
(disk-partitions)))))
|
||||
|
||||
(define (find-partition-by-uuid uuid)
|
||||
"Return the first partition whose unique identifier is UUID (a bytevector),
|
||||
or #f if none was found."
|
||||
(and=> (find (partition-uuid-predicate uuid)
|
||||
(disk-partitions))
|
||||
(cut string-append "/dev/" <>)))
|
||||
(define find-partition-by-label
|
||||
(find-partition partition-label-predicate))
|
||||
|
||||
(define (find-partition-by-luks-uuid uuid)
|
||||
"Return the first LUKS partition whose unique identifier is UUID (a bytevector),
|
||||
or #f if none was found."
|
||||
(and=> (find (partition-luks-uuid-predicate uuid)
|
||||
(disk-partitions))
|
||||
(cut string-append "/dev/" <>)))
|
||||
(define find-partition-by-uuid
|
||||
(find-partition partition-uuid-predicate))
|
||||
|
||||
(define find-partition-by-luks-uuid
|
||||
(find-partition luks-partition-uuid-predicate))
|
||||
|
||||
|
||||
;;;
|
||||
@@ -412,26 +466,34 @@ the following:
|
||||
|
||||
(define (check-file-system device type)
|
||||
"Run a file system check of TYPE on DEVICE."
|
||||
(define fsck
|
||||
(string-append "fsck." type))
|
||||
(define check-procedure
|
||||
(cond
|
||||
((string-prefix? "ext" type) check-ext2-file-system)
|
||||
((string-prefix? "btrfs" type) check-btrfs-file-system)
|
||||
(else #f)))
|
||||
|
||||
(let ((status (system* fsck "-v" "-p" "-C" "0" device)))
|
||||
(match (status:exit-val status)
|
||||
(0
|
||||
#t)
|
||||
(1
|
||||
(format (current-error-port) "'~a' corrected errors on ~a; continuing~%"
|
||||
fsck device))
|
||||
(2
|
||||
(format (current-error-port) "'~a' corrected errors on ~a; rebooting~%"
|
||||
fsck device)
|
||||
(sleep 3)
|
||||
(reboot))
|
||||
(code
|
||||
(format (current-error-port) "'~a' exited with code ~a on ~a; \
|
||||
spawning Bourne-like REPL~%"
|
||||
fsck code device)
|
||||
(start-repl %bournish-language)))))
|
||||
(if check-procedure
|
||||
(match (check-procedure device)
|
||||
('pass
|
||||
#t)
|
||||
('errors-corrected
|
||||
(format (current-error-port)
|
||||
"File system check corrected errors on ~a; continuing~%"
|
||||
device))
|
||||
('reboot-required
|
||||
(format (current-error-port)
|
||||
"File system check corrected errors on ~a; rebooting~%"
|
||||
device)
|
||||
(sleep 3)
|
||||
(reboot))
|
||||
('fatal-error
|
||||
(format (current-error-port)
|
||||
"File system check on ~a failed; spawning Bourne-like REPL~%"
|
||||
device)
|
||||
(start-repl %bournish-language)))
|
||||
(format (current-error-port)
|
||||
"No file system check procedure for ~a; skipping~%"
|
||||
device)))
|
||||
|
||||
(define (mount-flags->bit-mask flags)
|
||||
"Return the number suitable for the 'flags' argument of 'mount' that
|
||||
|
||||
+17
-8
@@ -7,7 +7,7 @@
|
||||
# Copyright © 2016 Kei Kebreau <kei@openmailbox.org>
|
||||
# Copyright © 2016 Rene Saavedra <rennes@openmailbox.org>
|
||||
# Copyright © 2016 Adonay "adfeno" Felipe Nogueira <https://libreplanet.org/wiki/User:Adfeno> <adfeno@openmailbox.org>
|
||||
# Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
|
||||
# Copyright © 2016, 2017 Ricardo Wurmus <rekado@elephly.net>
|
||||
# Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
|
||||
#
|
||||
# This file is part of GNU Guix.
|
||||
@@ -183,6 +183,7 @@ GNU_SYSTEM_MODULES = \
|
||||
%D%/packages/hurd.scm \
|
||||
%D%/packages/ibus.scm \
|
||||
%D%/packages/icu4c.scm \
|
||||
%D%/packages/idris.scm \
|
||||
%D%/packages/idutils.scm \
|
||||
%D%/packages/image.scm \
|
||||
%D%/packages/image-viewers.scm \
|
||||
@@ -271,6 +272,7 @@ GNU_SYSTEM_MODULES = \
|
||||
%D%/packages/networking.scm \
|
||||
%D%/packages/nfs.scm \
|
||||
%D%/packages/nickle.scm \
|
||||
%D%/packages/nim.scm \
|
||||
%D%/packages/ninja.scm \
|
||||
%D%/packages/node.scm \
|
||||
%D%/packages/noweb.scm \
|
||||
@@ -413,6 +415,7 @@ GNU_SYSTEM_MODULES = \
|
||||
%D%/services/lirc.scm \
|
||||
%D%/services/mail.scm \
|
||||
%D%/services/mcron.scm \
|
||||
%D%/services/messaging.scm \
|
||||
%D%/services/networking.scm \
|
||||
%D%/services/nfs.scm \
|
||||
%D%/services/shepherd.scm \
|
||||
@@ -497,6 +500,7 @@ dist_patch_DATA = \
|
||||
%D%/packages/patches/calibre-drop-unrar.patch \
|
||||
%D%/packages/patches/calibre-no-updates-dialog.patch \
|
||||
%D%/packages/patches/cdparanoia-fpic.patch \
|
||||
%D%/packages/patches/chicken-CVE-2016-6830+CVE-2016-6831.patch \
|
||||
%D%/packages/patches/chmlib-inttypes.patch \
|
||||
%D%/packages/patches/clang-libc-search-path.patch \
|
||||
%D%/packages/patches/clang-3.8-libc-search-path.patch \
|
||||
@@ -588,6 +592,7 @@ dist_patch_DATA = \
|
||||
%D%/packages/patches/gmp-faulty-test.patch \
|
||||
%D%/packages/patches/gnome-tweak-tool-search-paths.patch \
|
||||
%D%/packages/patches/gnucash-price-quotes-perl.patch \
|
||||
%D%/packages/patches/gnupg-test-segfault-on-32bit-arch.patch \
|
||||
%D%/packages/patches/gobject-introspection-absolute-shlib-path.patch \
|
||||
%D%/packages/patches/gobject-introspection-cc.patch \
|
||||
%D%/packages/patches/gobject-introspection-girepository.patch \
|
||||
@@ -635,11 +640,11 @@ dist_patch_DATA = \
|
||||
%D%/packages/patches/icu4c-CVE-2015-4760.patch \
|
||||
%D%/packages/patches/id3lib-CVE-2007-4460.patch \
|
||||
%D%/packages/patches/ilmbase-fix-tests.patch \
|
||||
%D%/packages/patches/inkscape-drop-wait-for-targets.patch \
|
||||
%D%/packages/patches/isl-0.11.1-aarch64-support.patch \
|
||||
%D%/packages/patches/jbig2dec-ignore-testtest.patch \
|
||||
%D%/packages/patches/jq-CVE-2015-8863.patch \
|
||||
%D%/packages/patches/kdbusaddons-kinit-file-name.patch \
|
||||
%D%/packages/patches/khal-disable-failing-tests.patch \
|
||||
%D%/packages/patches/khmer-use-libraries.patch \
|
||||
%D%/packages/patches/kmod-module-directory.patch \
|
||||
%D%/packages/patches/kobodeluxe-paths.patch \
|
||||
@@ -674,6 +679,7 @@ dist_patch_DATA = \
|
||||
%D%/packages/patches/libmad-armv7-thumb-pt2.patch \
|
||||
%D%/packages/patches/libmad-frame-length.patch \
|
||||
%D%/packages/patches/libmad-mips-newgcc.patch \
|
||||
%D%/packages/patches/libpng-CVE-2016-10087.patch \
|
||||
%D%/packages/patches/libssh-0.6.5-CVE-2016-0739.patch \
|
||||
%D%/packages/patches/libtar-CVE-2013-4420.patch \
|
||||
%D%/packages/patches/libtheora-config-guess.patch \
|
||||
@@ -695,6 +701,8 @@ dist_patch_DATA = \
|
||||
%D%/packages/patches/libwmf-CVE-2015-0848+CVE-2015-4588.patch \
|
||||
%D%/packages/patches/libwmf-CVE-2015-4695.patch \
|
||||
%D%/packages/patches/libwmf-CVE-2015-4696.patch \
|
||||
%D%/packages/patches/libxml2-CVE-2016-4658.patch \
|
||||
%D%/packages/patches/libxml2-CVE-2016-5131.patch \
|
||||
%D%/packages/patches/libxslt-generated-ids.patch \
|
||||
%D%/packages/patches/libxslt-CVE-2016-4738.patch \
|
||||
%D%/packages/patches/linux-pam-no-setfsuid.patch \
|
||||
@@ -726,6 +734,7 @@ dist_patch_DATA = \
|
||||
%D%/packages/patches/mpc123-initialize-ao.patch \
|
||||
%D%/packages/patches/mplayer2-theora-fix.patch \
|
||||
%D%/packages/patches/module-init-tools-moduledir.patch \
|
||||
%D%/packages/patches/multiqc-fix-git-subprocess-error.patch \
|
||||
%D%/packages/patches/mumps-build-parallelism.patch \
|
||||
%D%/packages/patches/mupdf-build-with-openjpeg-2.1.patch \
|
||||
%D%/packages/patches/mupen64plus-ui-console-notice.patch \
|
||||
@@ -744,7 +753,10 @@ dist_patch_DATA = \
|
||||
%D%/packages/patches/nvi-assume-preserve-path.patch \
|
||||
%D%/packages/patches/nvi-dbpagesize-binpower.patch \
|
||||
%D%/packages/patches/nvi-db4.patch \
|
||||
%D%/packages/patches/ocaml-bisect-fix-camlp4-in-another-directory.patch \
|
||||
%D%/packages/patches/ocaml-bitstring-fix-configure.patch \
|
||||
%D%/packages/patches/ocaml-CVE-2015-8869.patch \
|
||||
%D%/packages/patches/ocaml-Add-a-.file-directive.patch \
|
||||
%D%/packages/patches/ocaml-findlib-make-install.patch \
|
||||
%D%/packages/patches/ola-readdir-r.patch \
|
||||
%D%/packages/patches/openexr-missing-samples.patch \
|
||||
@@ -809,7 +821,6 @@ dist_patch_DATA = \
|
||||
%D%/packages/patches/python-3-search-paths.patch \
|
||||
%D%/packages/patches/python-3.4-fix-tests.patch \
|
||||
%D%/packages/patches/python-3.5-fix-tests.patch \
|
||||
%D%/packages/patches/python-dendropy-exclude-failing-tests.patch \
|
||||
%D%/packages/patches/python-file-double-encoding-bug.patch \
|
||||
%D%/packages/patches/python-fix-tests.patch \
|
||||
%D%/packages/patches/python-parse-too-many-fields.patch \
|
||||
@@ -818,10 +829,9 @@ dist_patch_DATA = \
|
||||
%D%/packages/patches/python-configobj-setuptools.patch \
|
||||
%D%/packages/patches/python-paste-remove-website-test.patch \
|
||||
%D%/packages/patches/python-paste-remove-timing-test.patch \
|
||||
%D%/packages/patches/python-pycrypto-CVE-2013-7459.patch \
|
||||
%D%/packages/patches/python2-pygobject-2-gi-info-type-error-domain.patch \
|
||||
%D%/packages/patches/qemu-CVE-2016-8576.patch \
|
||||
%D%/packages/patches/qemu-CVE-2016-8577.patch \
|
||||
%D%/packages/patches/qemu-CVE-2016-8578.patch \
|
||||
%D%/packages/patches/python-pygpgme-fix-pinentry-tests.patch \
|
||||
%D%/packages/patches/qt4-ldflags.patch \
|
||||
%D%/packages/patches/quickswitch-fix-dmenu-check.patch \
|
||||
%D%/packages/patches/rapicorn-isnan.patch \
|
||||
@@ -836,7 +846,6 @@ dist_patch_DATA = \
|
||||
%D%/packages/patches/ruby-puma-ignore-broken-test.patch \
|
||||
%D%/packages/patches/ruby-rack-ignore-failing-test.patch \
|
||||
%D%/packages/patches/ruby-tzinfo-data-ignore-broken-test.patch\
|
||||
%D%/packages/patches/ruby-yard-fix-skip-of-markdown-tests.patch \
|
||||
%D%/packages/patches/sed-hurd-path-max.patch \
|
||||
%D%/packages/patches/scheme48-tests.patch \
|
||||
%D%/packages/patches/scotch-test-threading.patch \
|
||||
@@ -849,7 +858,6 @@ dist_patch_DATA = \
|
||||
%D%/packages/patches/slim-sigusr1.patch \
|
||||
%D%/packages/patches/slim-reset.patch \
|
||||
%D%/packages/patches/slim-login.patch \
|
||||
%D%/packages/patches/slock-CVE-2016-6866.patch \
|
||||
%D%/packages/patches/slurm-configure-remove-nonfree-contribs.patch \
|
||||
%D%/packages/patches/soprano-find-clucene.patch \
|
||||
%D%/packages/patches/steghide-fixes.patch \
|
||||
@@ -877,6 +885,7 @@ dist_patch_DATA = \
|
||||
%D%/packages/patches/tophat-build-with-later-seqan.patch \
|
||||
%D%/packages/patches/totem-debug-format-fix.patch \
|
||||
%D%/packages/patches/tuxpaint-stamps-path.patch \
|
||||
%D%/packages/patches/unrtf-CVE-2016-10091.patch \
|
||||
%D%/packages/patches/unzip-CVE-2014-8139.patch \
|
||||
%D%/packages/patches/unzip-CVE-2014-8140.patch \
|
||||
%D%/packages/patches/unzip-CVE-2014-8141.patch \
|
||||
|
||||
@@ -9,7 +9,7 @@
|
||||
;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
|
||||
;;; Copyright © 2016 Pjotr Prins <pjotr.guix@thebird.nl>
|
||||
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
|
||||
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
|
||||
;;; Copyright © 2016, 2017 Efraim Flashner <efraim@flashner.co.il>
|
||||
;;; Copyright © 2016 Peter Feigl <peter.feigl@nexoid.at>
|
||||
;;; Copyright © 2016 John J. Foerch <jjfoerch@earthlink.net>
|
||||
;;; Coypright © 2016 ng0 <ng0@we.make.ritual.n0.is>
|
||||
@@ -362,7 +362,7 @@ login, passwd, su, groupadd, and useradd.")
|
||||
#:tests? #f)) ; no tests
|
||||
(inputs `(("shadow" ,shadow)))
|
||||
|
||||
(home-page "http://sourceforge.net/projects/mingetty")
|
||||
(home-page "https://sourceforge.net/projects/mingetty")
|
||||
(synopsis "Getty for the text console")
|
||||
(description
|
||||
"Small console getty that is started on the Linux text console,
|
||||
@@ -717,7 +717,7 @@ by bandwidth they use.")
|
||||
`("PERL5LIB" ":" prefix (,x11-inc ,tk-inc)))))
|
||||
%standard-phases)))
|
||||
;; The clusterssh.sourceforge.net address requires login to view
|
||||
(home-page "http://sourceforge.net/projects/clusterssh/")
|
||||
(home-page "https://sourceforge.net/projects/clusterssh/")
|
||||
(synopsis "Secure concurrent multi-server terminal control")
|
||||
(description
|
||||
"ClusterSSH controls a number of xterm windows via a single graphical
|
||||
@@ -790,7 +790,7 @@ system administrator.")
|
||||
(define-public sudo
|
||||
(package
|
||||
(name "sudo")
|
||||
(version "1.8.17p1")
|
||||
(version "1.8.19p1")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri
|
||||
@@ -800,7 +800,7 @@ system administrator.")
|
||||
version ".tar.gz")))
|
||||
(sha256
|
||||
(base32
|
||||
"1k2mn65l1kmsxm8wh0gjxy496xhbpiimbpm6yv6kw6snzc3xg466"))))
|
||||
"14pwdwl03kdbbyjkvxrfx409x3c1fjqz8aqz2wgwddinhz7v3bxq"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
`(#:configure-flags
|
||||
@@ -1568,14 +1568,14 @@ done with the @code{auditctl} utility.")
|
||||
(define-public nmap
|
||||
(package
|
||||
(name "nmap")
|
||||
(version "7.31")
|
||||
(version "7.40")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "https://nmap.org/dist/nmap-" version
|
||||
".tar.bz2"))
|
||||
(sha256
|
||||
(base32
|
||||
"0hiqb28950kn4bjsmw0ksfyss7j2qdmgrj3xsjf7073pq01lx7yb"))
|
||||
"121i9mgyc28ra2825akd0ix5qyssv4xc2qlx296mam6hzxgnc54y"))
|
||||
(modules '((guix build utils)))
|
||||
(snippet
|
||||
'(map delete-file-recursively
|
||||
|
||||
+11
-10
@@ -1,6 +1,6 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2012, 2013, 2014, 2015, 2016 Andreas Enge <andreas@enge.fr>
|
||||
;;; Copyright © 2013, 2015 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2013, 2015, 2017 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2016 Nicolas Goaziou <mail@nicolasgoaziou.fr>
|
||||
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
|
||||
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
|
||||
@@ -577,21 +577,22 @@ cosine/ sine transforms or DCT/DST).")
|
||||
(string-append (package-description fftw)
|
||||
" Single-precision version."))))
|
||||
|
||||
;; FIXME: These packages are used temporarily by packages like Ardour until
|
||||
;; "--enable-flags" is added to the fftw and fftwf packages.
|
||||
(define-public fftw-with-threads
|
||||
(package (inherit fftw)
|
||||
(define (pthread-variant p)
|
||||
(package
|
||||
(inherit p)
|
||||
(name (string-append (package-name p) "-pthreads"))
|
||||
(arguments
|
||||
(substitute-keyword-arguments (package-arguments fftw)
|
||||
((#:configure-flags flags)
|
||||
`(cons "--enable-threads" ,flags))))))
|
||||
|
||||
;; FIXME: These packages are used temporarily by packages like Ardour until
|
||||
;; "--enable-flags" is added to the fftw and fftwf packages.
|
||||
(define-public fftw-with-threads
|
||||
(pthread-variant fftw))
|
||||
|
||||
(define-public fftwf-with-threads
|
||||
(package (inherit fftwf)
|
||||
(arguments
|
||||
(substitute-keyword-arguments (package-arguments fftwf)
|
||||
((#:configure-flags flags)
|
||||
`(cons "--enable-threads" ,flags))))))
|
||||
(pthread-variant fftwf))
|
||||
|
||||
(define-public fftw-openmpi
|
||||
(package (inherit fftw)
|
||||
|
||||
@@ -5,7 +5,7 @@
|
||||
;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
|
||||
;;; Copyright © 2015, 2016 Mark H Weaver <mhw@netris.org>
|
||||
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
|
||||
;;; Copyright © 2016 Alex Griffin <a@ajgrf.com>
|
||||
;;; Copyright © 2016, 2017 Alex Griffin <a@ajgrf.com>
|
||||
;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is>
|
||||
;;; Copyright © 2016 Lukas Gradl <lgradl@openmailbox.org>
|
||||
;;; Copyright © 2016 Tobias Geerinckx-Rice <me@tobias.gr>
|
||||
@@ -1448,7 +1448,7 @@ connections between them.")
|
||||
(build-system gnu-build-system)
|
||||
(native-inputs `(("pkg-config" ,pkg-config)))
|
||||
(inputs `(("libsndfile" ,libsndfile)))
|
||||
(home-page "http://sourceforge.net/projects/bs2b/")
|
||||
(home-page "https://sourceforge.net/projects/bs2b/")
|
||||
(synopsis "Bauer stereophonic-to-binaural DSP")
|
||||
(description
|
||||
"The Bauer stereophonic-to-binaural DSP (bs2b) library and plugins is
|
||||
@@ -2279,7 +2279,7 @@ can play and record audio files.")
|
||||
(base32 "1hmadwqfpg15vhwq9pa1sl5xslibrjpk6hpq2s9hfmx1s5l6ihfw"))))
|
||||
(build-system cmake-build-system)
|
||||
(arguments '(#:tests? #f)) ;no 'check' target
|
||||
(home-page "http://sourceforge.net/p/soxr/wiki/Home/")
|
||||
(home-page "https://sourceforge.net/p/soxr/wiki/Home/")
|
||||
(synopsis "One-dimensional sample-rate conversion library")
|
||||
(description
|
||||
"The SoX Resampler library (libsoxr) performs one-dimensional sample-rate
|
||||
@@ -2699,7 +2699,7 @@ with support for HD extensions.")
|
||||
(define-public bs1770gain
|
||||
(package
|
||||
(name "bs1770gain")
|
||||
(version "0.4.11")
|
||||
(version "0.4.12")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
@@ -2707,7 +2707,7 @@ with support for HD extensions.")
|
||||
version "/bs1770gain-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0j765drdb7h3y5ipjv9sg1a0if6zh8cksbv3rdk5ppd7kxcrjnlb"))))
|
||||
"0n9skdap1vnl6w52fx0gsrjlk7w3xgdwi62ycyf96h29rx059z6a"))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs `(("ffmpeg" ,ffmpeg)
|
||||
("sox" ,sox)))
|
||||
|
||||
+57
-21
@@ -2,6 +2,7 @@
|
||||
;;; Copyright © 2014, 2015 Eric Bavier <bavier@member.fsf.org>
|
||||
;;; Copyright © 2014 Ian Denhardt <ian@zenhack.net>
|
||||
;;; Copyright © 2015, 2016 Leo Famulari <leo@famulari.name>
|
||||
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -404,13 +405,13 @@ detection, and lossless compression.")
|
||||
(define-public borg
|
||||
(package
|
||||
(name "borg")
|
||||
(version "1.0.8")
|
||||
(version "1.0.9")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (pypi-uri "borgbackup" version))
|
||||
(sha256
|
||||
(base32
|
||||
"1fdfi0yzzdrrlml6780n4fh61sqm7pw6fcd1y67kfkvw8hy5c0k9"))
|
||||
"1ciwp9yilcibk0x82y5nn8ps95jrm8rxvff8mjrlp7a2w100i1im"))
|
||||
(modules '((guix build utils)))
|
||||
(snippet
|
||||
'(for-each
|
||||
@@ -439,25 +440,26 @@ detection, and lossless compression.")
|
||||
(lambda* (#:key inputs outputs #:allow-other-keys)
|
||||
;; Make the installed package available for the test suite.
|
||||
(add-installed-pythonpath inputs outputs)
|
||||
(zero?
|
||||
(system* "py.test" "-v" "--pyargs" "borg.testsuite" "-k"
|
||||
(string-append
|
||||
;; These tests need to write to '/var'.
|
||||
"not test_get_cache_dir "
|
||||
"and not test_get_keys_dir "
|
||||
;; These tests assume there is a root user in
|
||||
;; '/etc/passwd'.
|
||||
"and not test_access_acl "
|
||||
"and not test_default_acl "
|
||||
"and not test_non_ascii_acl "
|
||||
;; This test needs the unpackaged pytest-benchmark.
|
||||
"and not benchmark "
|
||||
;; These tests assume the kernel supports FUSE. They
|
||||
;; were skipped using the "old" Python build system,
|
||||
;; before commit
|
||||
;; 7db40bce58e149ecb541d295e01cfbfe953d39a3.
|
||||
"and not test_fuse "
|
||||
"and not test_fuse_allow_damaged_files")))))
|
||||
;; The tests should be run in an empty directory.
|
||||
(mkdir-p "tests")
|
||||
(with-directory-excursion "tests"
|
||||
(zero?
|
||||
(system* "py.test" "-v" "--pyargs" "borg.testsuite" "-k"
|
||||
(string-append
|
||||
;; These tests need to write to '/var'.
|
||||
"not test_get_cache_dir "
|
||||
"and not test_get_keys_dir "
|
||||
"and not test_get_security_dir "
|
||||
;; These tests assume there is a root user in
|
||||
;; '/etc/passwd'.
|
||||
"and not test_access_acl "
|
||||
"and not test_default_acl "
|
||||
"and not test_non_ascii_acl "
|
||||
;; This test needs the unpackaged pytest-benchmark.
|
||||
"and not benchmark "
|
||||
;; These tests assume the kernel supports FUSE.
|
||||
"and not test_fuse "
|
||||
"and not test_fuse_allow_damaged_files"))))))
|
||||
(add-after 'install 'install-doc
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(let* ((out (assoc-ref outputs "out"))
|
||||
@@ -543,3 +545,37 @@ changes are stored.")
|
||||
(home-page "https://attic-backup.org/")
|
||||
(license license:bsd-3)
|
||||
(properties `((superseded . ,borg)))))
|
||||
|
||||
(define-public wimlib
|
||||
(package
|
||||
(name "wimlib")
|
||||
(version "1.10.0")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "https://wimlib.net/downloads/"
|
||||
name "-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0mbz03smlc054i2m9q2sbqymml9m897kfs84q7g81i26y811p6wq"))))
|
||||
(build-system gnu-build-system)
|
||||
(native-inputs
|
||||
`(("pkg-config" ,pkg-config)))
|
||||
(inputs
|
||||
`(("fuse" ,fuse)
|
||||
("libxml2" ,libxml2)
|
||||
("ntfs-3g" ,ntfs-3g)
|
||||
("openssl" ,openssl)))
|
||||
(arguments
|
||||
`(#:configure-flags (list "--enable-test-support")))
|
||||
(home-page "https://wimlib.net/")
|
||||
(synopsis "WIM file manipulation library and utilities")
|
||||
(description "wimlib is a C library and set of command-line utilities for
|
||||
creating, modifying, extracting, and mounting archives in the Windows Imaging
|
||||
Format (@dfn{WIM files}). It can capture and apply WIMs directly from and to
|
||||
NTFS volumes using @code{ntfs-3g}, preserving NTFS-specific attributes.")
|
||||
;; wimlib is dual-licenced under version 3 or later of either the GPL or
|
||||
;; LGPL, except those files explicitly marked as being released into the
|
||||
;; public domain (CC0) in their headers.
|
||||
(license (list license:gpl3+
|
||||
license:lgpl3+
|
||||
license:cc0))))
|
||||
|
||||
@@ -679,14 +679,14 @@ with the Linux kernel.")
|
||||
;; The Hurd's libc variant.
|
||||
(package (inherit glibc/linux)
|
||||
(name "glibc-hurd")
|
||||
(version "2.19")
|
||||
(version "2.23")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "http://alpha.gnu.org/gnu/hurd/glibc-"
|
||||
version "-hurd+libpthread-20160518" ".tar.gz"))
|
||||
version "-hurd+libpthread-20161218" ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"12zmdjviybpsdb2kq4cg98rds7909f0cc96fzdahdfrzlxx1q0px"))))
|
||||
"0vpdv05j6j3ria5bw8gp468i64gij94cslxkxj9xkfgi6p615b8p"))))
|
||||
|
||||
;; Libc provides <hurd.h>, which includes a bunch of Hurd and Mach headers,
|
||||
;; so both should be propagated.
|
||||
@@ -722,6 +722,9 @@ with the Linux kernel.")
|
||||
;; We need this to get a working openpty() function.
|
||||
"--enable-pt_chown"
|
||||
|
||||
;; <https://lists.gnu.org/archive/html/bug-hurd/2016-10/msg00033.html>
|
||||
"--disable-werror"
|
||||
|
||||
;; nscd fails to build for GNU/Hurd:
|
||||
;; <https://lists.gnu.org/archive/html/bug-hurd/2014-07/msg00006.html>.
|
||||
;; Disable it.
|
||||
|
||||
+139
-55
@@ -1,5 +1,5 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2014, 2015, 2016 Ricardo Wurmus <rekado@elephly.net>
|
||||
;;; Copyright © 2014, 2015, 2016, 2017 Ricardo Wurmus <rekado@elephly.net>
|
||||
;;; Copyright © 2015, 2016 Ben Woodcroft <donttrustben@gmail.com>
|
||||
;;; Copyright © 2015, 2016 Pjotr Prins <pjotr.guix@thebird.nl>
|
||||
;;; Copyright © 2015 Andreas Enge <andreas@enge.fr>
|
||||
@@ -1097,7 +1097,7 @@ confidence to have in an alignment.")
|
||||
("pigz" ,pigz)
|
||||
("zlib" ,zlib)))
|
||||
(supported-systems '("x86_64-linux"))
|
||||
(home-page "http://sourceforge.net/p/bless-ec/wiki/Home/")
|
||||
(home-page "https://sourceforge.net/p/bless-ec/wiki/Home/")
|
||||
(synopsis "Bloom-filter-based error correction tool for NGS reads")
|
||||
(description
|
||||
"@dfn{Bloom-filter-based error correction solution for high-throughput
|
||||
@@ -1478,15 +1478,15 @@ high-throughput sequencing data – with an emphasis on simplicity.")
|
||||
(define-public cd-hit
|
||||
(package
|
||||
(name "cd-hit")
|
||||
(version "4.6.5")
|
||||
(version "4.6.6")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "https://github.com/weizhongli/cdhit"
|
||||
"/releases/download/V" version
|
||||
"/cd-hit-v" version "-2016-0304.tar.gz"))
|
||||
"/cd-hit-v" version "-2016-0711.tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"15db0hq38yyifwqx9b6l34z14jcq576dmjavhj8a426c18lvnhp3"))))
|
||||
"1w8hd4fszgg29nqiz569fldwy012la77nljcmlhglgicws56z54p"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
`(#:tests? #f ; there are no tests
|
||||
@@ -1930,19 +1930,14 @@ accessing bigWig files.")
|
||||
(define-public python-dendropy
|
||||
(package
|
||||
(name "python-dendropy")
|
||||
(version "4.1.0")
|
||||
(version "4.2.0")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (pypi-uri "DendroPy" version))
|
||||
(sha256
|
||||
(base32
|
||||
"1jfz7gp18wph311w1yygbvjanb3n5mdqal439bb6myw41dwb5m63"))
|
||||
;; There are two known test failures that will be fixed in the next
|
||||
;; release after 4.1.0.
|
||||
;; https://github.com/jeetsukumaran/DendroPy/issues/48
|
||||
(patches (search-patches
|
||||
"python-dendropy-exclude-failing-tests.patch"))))
|
||||
"15c7s3d5gf19ljsxvq5advaa752wfi7pwrdjyhzmg85hccyvp47p"))))
|
||||
(build-system python-build-system)
|
||||
(home-page "http://packages.python.org/DendroPy/")
|
||||
(synopsis "Library for phylogenetics and phylogenetic computing")
|
||||
@@ -1957,15 +1952,6 @@ trees (phylogenies) and characters.")
|
||||
(let ((base (package-with-python2 (strip-python2-variant python-dendropy))))
|
||||
(package
|
||||
(inherit base)
|
||||
;; Do not use same source as 'python-dendropy' because the patched
|
||||
;; failing tests do not occur on Python 2.
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (pypi-uri "DendroPy" (package-version base)))
|
||||
(sha256
|
||||
(base32
|
||||
"1jfz7gp18wph311w1yygbvjanb3n5mdqal439bb6myw41dwb5m63"))))
|
||||
(arguments
|
||||
`(#:python ,python-2
|
||||
#:phases
|
||||
@@ -2020,7 +2006,7 @@ identify enrichments with functional annotations of the genome.")
|
||||
(define-public diamond
|
||||
(package
|
||||
(name "diamond")
|
||||
(version "0.8.29")
|
||||
(version "0.8.31")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
@@ -2029,7 +2015,7 @@ identify enrichments with functional annotations of the genome.")
|
||||
(file-name (string-append name "-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1mnhj7y13pk2bhfichjma5aw8ssdiqyria61ip1kps6facqlal3z"))))
|
||||
"0nh79f4rpgq8vmlga743r7vd0z0ik6spy34f7vfq0v9lcmvfr7xq"))))
|
||||
(build-system cmake-build-system)
|
||||
(arguments
|
||||
'(#:tests? #f ; no "check" target
|
||||
@@ -5227,20 +5213,21 @@ data types as well.")
|
||||
(define-public r-annotate
|
||||
(package
|
||||
(name "r-annotate")
|
||||
(version "1.52.0")
|
||||
(version "1.52.1")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (bioconductor-uri "annotate" version))
|
||||
(sha256
|
||||
(base32
|
||||
"1fd2csq7dcs2gwndgwdx2nwkymz8gsmlnqqzv3p0vjjsvvq5n2a8"))))
|
||||
"0yymz8qxgnbybvfhqrgkd1hh9dhwxdii1yxkhr1zicjgb35xixxb"))))
|
||||
(build-system r-build-system)
|
||||
(propagated-inputs
|
||||
`(("r-annotationdbi" ,r-annotationdbi)
|
||||
("r-biobase" ,r-biobase)
|
||||
("r-biocgenerics" ,r-biocgenerics)
|
||||
("r-dbi" ,r-dbi)
|
||||
("r-rcurl" ,r-rcurl)
|
||||
("r-xml" ,r-xml)
|
||||
("r-xtable" ,r-xtable)))
|
||||
(home-page
|
||||
@@ -5304,14 +5291,14 @@ high-throughput sequencing experiments.")
|
||||
(define-public r-deseq2
|
||||
(package
|
||||
(name "r-deseq2")
|
||||
(version "1.14.0")
|
||||
(version "1.14.1")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (bioconductor-uri "DESeq2" version))
|
||||
(sha256
|
||||
(base32
|
||||
"0kq06jy4xg5ii3a9l62f17kirsfx0gsiwq6mhiy985cqzpdn893g"))))
|
||||
"1walwkqryn1gnwz7zryr5764a0p6ia7ag4w6w9n8fskg8dkg0fqs"))))
|
||||
(properties `((upstream-name . "DESeq2")))
|
||||
(build-system r-build-system)
|
||||
(arguments
|
||||
@@ -5821,14 +5808,14 @@ generate FASTA, JSON, YAML, RDF, JSON-LD, HTML, CSV, tabular output etc.")
|
||||
(define-public bioruby
|
||||
(package
|
||||
(name "bioruby")
|
||||
(version "1.5.0")
|
||||
(version "1.5.1")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (rubygems-uri "bio" version))
|
||||
(sha256
|
||||
(base32
|
||||
"01k2fyjl5fpx4zn8g6gqiqvsg2j1fgixrs9p03vzxckynxdq3wmc"))))
|
||||
"0hdl0789c9n4mprnx5pgd46bfwl8d000rqpamj5h6kkjgspijv49"))))
|
||||
(build-system ruby-build-system)
|
||||
(propagated-inputs
|
||||
`(("ruby-libxml" ,ruby-libxml)))
|
||||
@@ -5957,13 +5944,13 @@ also known as views, in a controlled vocabulary.")
|
||||
(define-public r-biocstyle
|
||||
(package
|
||||
(name "r-biocstyle")
|
||||
(version "2.2.0")
|
||||
(version "2.2.1")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (bioconductor-uri "BiocStyle" version))
|
||||
(sha256
|
||||
(base32
|
||||
"0qbk23fz8cn260isd9xlh9lxfj4adar6iqzai01c4kz0p31f45za"))))
|
||||
"0sl99xw940ixrm6v24lgaw3ljh56g59a6rdz7g160hx84z9f8n2n"))))
|
||||
(properties
|
||||
`((upstream-name . "BiocStyle")))
|
||||
(build-system r-build-system)
|
||||
@@ -6092,13 +6079,13 @@ abnormal copy number.")
|
||||
(define-public r-s4vectors
|
||||
(package
|
||||
(name "r-s4vectors")
|
||||
(version "0.12.0")
|
||||
(version "0.12.1")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (bioconductor-uri "S4Vectors" version))
|
||||
(sha256
|
||||
(base32
|
||||
"0m0npc0vhmcwcxws7v2f8k4hvvrjvnlrsr94klxf4a8m4xw2xzzk"))))
|
||||
"0i36y3w36h3d8rmazxcrip4gvn54rd9av1wz4lygsprrjmylfhcc"))))
|
||||
(properties
|
||||
`((upstream-name . "S4Vectors")))
|
||||
(build-system r-build-system)
|
||||
@@ -6144,13 +6131,13 @@ utilities for sequence data management under the ACNUC system.")
|
||||
(define-public r-iranges
|
||||
(package
|
||||
(name "r-iranges")
|
||||
(version "2.8.0")
|
||||
(version "2.8.1")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (bioconductor-uri "IRanges" version))
|
||||
(sha256
|
||||
(base32
|
||||
"0cdl1sfd3cvf93lnz91fdk64fbg1mnd5g958dwh1il8r358hqq3f"))))
|
||||
"0cryqnpqb3p6l9jjw27hyqd550sxlljls3ka7b9rb38hkji7b5hw"))))
|
||||
(properties
|
||||
`((upstream-name . "IRanges")))
|
||||
(build-system r-build-system)
|
||||
@@ -6173,13 +6160,13 @@ possible.")
|
||||
(define-public r-genomeinfodb
|
||||
(package
|
||||
(name "r-genomeinfodb")
|
||||
(version "1.10.0")
|
||||
(version "1.10.2")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (bioconductor-uri "GenomeInfoDb" version))
|
||||
(sha256
|
||||
(base32
|
||||
"0nhg4bk38gzvf3mvnbqgisbbhfv1kzjld27z1z9knnlkplkiyyyv"))))
|
||||
"0zh894qd1sgpjbn0wfvq6hs2dzn7y1pyicvzk2aa48y3zbidanv7"))))
|
||||
(properties
|
||||
`((upstream-name . "GenomeInfoDb")))
|
||||
(build-system r-build-system)
|
||||
@@ -6199,13 +6186,13 @@ names in their natural, rather than lexicographic, order.")
|
||||
(define-public r-edger
|
||||
(package
|
||||
(name "r-edger")
|
||||
(version "3.16.1")
|
||||
(version "3.16.5")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (bioconductor-uri "edgeR" version))
|
||||
(sha256
|
||||
(base32
|
||||
"1r6hhwkqp13m022hjajzr1lnjsbai0yjhykwn0kp1f0la990a808"))))
|
||||
"04vpa0a6dkkjyvvfbkmfjyaxf2ldkagi66g028qpaszd8jsk8yiv"))))
|
||||
(properties `((upstream-name . "edgeR")))
|
||||
(build-system r-build-system)
|
||||
(propagated-inputs
|
||||
@@ -6225,13 +6212,13 @@ CAGE.")
|
||||
(define-public r-variantannotation
|
||||
(package
|
||||
(name "r-variantannotation")
|
||||
(version "1.20.0")
|
||||
(version "1.20.2")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (bioconductor-uri "VariantAnnotation" version))
|
||||
(sha256
|
||||
(base32
|
||||
"1lwzfgahz8ipwli73kcfqb18y6adi129hap1gnycnj3980m54i8q"))))
|
||||
"165wda1d2jagd907pnra4m3sla66icyqxvd60xpv09jl5agd5mn9"))))
|
||||
(properties
|
||||
`((upstream-name . "VariantAnnotation")))
|
||||
(inputs
|
||||
@@ -6263,13 +6250,13 @@ coding changes and predict coding outcomes.")
|
||||
(define-public r-limma
|
||||
(package
|
||||
(name "r-limma")
|
||||
(version "3.30.2")
|
||||
(version "3.30.7")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (bioconductor-uri "limma" version))
|
||||
(sha256
|
||||
(base32
|
||||
"04jris7wk2lxksrrvrjsysznsdb2k04lfgrnp18ic49sazva0hfy"))))
|
||||
"1xg9w4lmn9n4hwyflxiwi6g969lcy569cg4z1x47crwwg7z7qdka"))))
|
||||
(build-system r-build-system)
|
||||
(home-page "http://bioinf.wehi.edu.au/limma")
|
||||
(synopsis "Package for linear models for microarray and RNA-seq data")
|
||||
@@ -6318,13 +6305,13 @@ different technologies, including microarrays, RNA-seq, and quantitative PCR.")
|
||||
(define-public r-genomicranges
|
||||
(package
|
||||
(name "r-genomicranges")
|
||||
(version "1.26.1")
|
||||
(version "1.26.2")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (bioconductor-uri "GenomicRanges" version))
|
||||
(sha256
|
||||
(base32
|
||||
"039nxccg9i2an8q2wni79x8dr9p1fcfcqvih9hg9w243pczg2g3c"))))
|
||||
"0if5dswkp77lyqppd0z2iyvnwag9h1gsr03707s8npcx13mzpsia"))))
|
||||
(properties
|
||||
`((upstream-name . "GenomicRanges")))
|
||||
(build-system r-build-system)
|
||||
@@ -6450,13 +6437,13 @@ objects.")
|
||||
(define-public r-biostrings
|
||||
(package
|
||||
(name "r-biostrings")
|
||||
(version "2.42.0")
|
||||
(version "2.42.1")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (bioconductor-uri "Biostrings" version))
|
||||
(sha256
|
||||
(base32
|
||||
"08z8lkz3axa94wkf144a931ry6vf6cc25avi1ywr84ln2k5czz9f"))))
|
||||
"0vqgd9i6y3wj4zviqwgvwgd4qj6033fg01rmx1cw9bw5i8ans42d"))))
|
||||
(properties
|
||||
`((upstream-name . "Biostrings")))
|
||||
(build-system r-build-system)
|
||||
@@ -6627,13 +6614,13 @@ as well as query and modify the browser state, such as the current viewport.")
|
||||
(define-public r-genomicfeatures
|
||||
(package
|
||||
(name "r-genomicfeatures")
|
||||
(version "1.26.0")
|
||||
(version "1.26.2")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (bioconductor-uri "GenomicFeatures" version))
|
||||
(sha256
|
||||
(base32
|
||||
"0z8spi2knwzwi10c38vr7xlvi3ah9faj7m1lka880mmxkl9cai4k"))))
|
||||
"1ybi6r3bax07wlv2qcd34y5qjdvcqcfayfvlrjc39ifrkk65wv4f"))))
|
||||
(properties
|
||||
`((upstream-name . "GenomicFeatures")))
|
||||
(build-system r-build-system)
|
||||
@@ -7239,7 +7226,7 @@ throughput genetic sequencing data sets using regression methods.")
|
||||
(define-public r-qtl
|
||||
(package
|
||||
(name "r-qtl")
|
||||
(version "1.39-5")
|
||||
(version "1.40-8")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
@@ -7247,7 +7234,7 @@ throughput genetic sequencing data sets using regression methods.")
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1grwgvyv7x0dgay1858bg7qf4wk47gpnq7qkqpcda9cn0h970d6f"))))
|
||||
"05bj1x2ry0i7yqiydlswb3d2h4pxg70z8w1072az1mrv1m54k8sp"))))
|
||||
(build-system r-build-system)
|
||||
(home-page "http://rqtl.org/")
|
||||
(synopsis "R package for analyzing QTL experiments in genetics")
|
||||
@@ -7363,7 +7350,7 @@ paired-end data.")
|
||||
(define-public r-rcas
|
||||
(package
|
||||
(name "r-rcas")
|
||||
(version "1.0.0")
|
||||
(version "1.1.1")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "https://github.com/BIMSBbioinfo/RCAS/archive/v"
|
||||
@@ -7371,7 +7358,7 @@ paired-end data.")
|
||||
(file-name (string-append name "-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1h7di822ihgkhmmmlfbfz3c2dkjyjxl307i6mx8w0cwjqbna1kp6"))))
|
||||
"1hd0r66556bxbdd82ksjklq7nfli36l4k6y88ic7kkg9873wa1nw"))))
|
||||
(build-system r-build-system)
|
||||
(native-inputs
|
||||
`(("r-knitr" ,r-knitr)
|
||||
@@ -7393,6 +7380,7 @@ paired-end data.")
|
||||
("r-topgo" ,r-topgo)
|
||||
("r-dt" ,r-dt)
|
||||
("r-plotly" ,r-plotly)
|
||||
("r-plotrix" ,r-plotrix)
|
||||
("r-motifrg" ,r-motifrg)
|
||||
("r-genomation" ,r-genomation)
|
||||
("r-genomicfeatures" ,r-genomicfeatures)
|
||||
@@ -7853,15 +7841,20 @@ replacement for strverscmp.")
|
||||
(define-public multiqc
|
||||
(package
|
||||
(name "multiqc")
|
||||
(version "0.6")
|
||||
(version "0.9")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (pypi-uri "multiqc" version))
|
||||
(sha256
|
||||
(base32
|
||||
"0avw11h63ldpxy5pizc3wl1wa01ha7q10wb240nggsjz3jaqvyiy"))))
|
||||
"12gs1jw2jrxrij529rnl5kaqxfcqn15yzcsggxkfhdx634ml0cny"))
|
||||
(patches (search-patches "multiqc-fix-git-subprocess-error.patch"))))
|
||||
(build-system python-build-system)
|
||||
(arguments
|
||||
;; Tests are to be introduced in the next version, see
|
||||
;; https://github.com/ewels/MultiQC/issues/376
|
||||
`(#:tests? #f))
|
||||
(propagated-inputs
|
||||
`(("python-jinja2" ,python-jinja2)
|
||||
("python-simplejson" ,python-simplejson)
|
||||
@@ -7876,3 +7869,94 @@ replacement for strverscmp.")
|
||||
samples into a single report. It contains modules for a large number of
|
||||
common bioinformatics tools.")
|
||||
(license license:gpl3)))
|
||||
|
||||
(define-public r-chipseq
|
||||
(package
|
||||
(name "r-chipseq")
|
||||
(version "1.24.0")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (bioconductor-uri "chipseq" version))
|
||||
(sha256
|
||||
(base32
|
||||
"115ayp82rs99iaswrx45skw1i5iacgwzz5k8rzijbp5qic0554n0"))))
|
||||
(build-system r-build-system)
|
||||
(propagated-inputs
|
||||
`(("r-biocgenerics" ,r-biocgenerics)
|
||||
("r-genomicranges" ,r-genomicranges)
|
||||
("r-iranges" ,r-iranges)
|
||||
("r-s4vectors" ,r-s4vectors)
|
||||
("r-shortread" ,r-shortread)))
|
||||
(home-page "http://bioconductor.org/packages/chipseq")
|
||||
(synopsis "Package for analyzing ChIPseq data")
|
||||
(description
|
||||
"This package provides tools for processing short read data from ChIPseq
|
||||
experiments.")
|
||||
(license license:artistic2.0)))
|
||||
|
||||
(define-public r-copyhelper
|
||||
(package
|
||||
(name "r-copyhelper")
|
||||
(version "1.6.0")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "http://bioconductor.org/packages/release/"
|
||||
"data/experiment/src/contrib/CopyhelpeR_"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0x7cyynjmxls9as2gg0iyp9x5fpalxmdjq914ss7i84i9zyk5bhq"))))
|
||||
(properties `((upstream-name . "CopyhelpeR")))
|
||||
(build-system r-build-system)
|
||||
(home-page "http://bioconductor.org/packages/CopyhelpeR/")
|
||||
(synopsis "Helper files for CopywriteR")
|
||||
(description
|
||||
"This package contains the helper files that are required to run the
|
||||
Bioconductor package CopywriteR. It contains pre-assembled 1kb bin GC-content
|
||||
and mappability files for the reference genomes hg18, hg19, hg38, mm9 and
|
||||
mm10. In addition, it contains a blacklist filter to remove regions that
|
||||
display copy number variation. Files are stored as GRanges objects from the
|
||||
GenomicRanges Bioconductor package.")
|
||||
(license license:gpl2)))
|
||||
|
||||
(define-public r-copywriter
|
||||
(package
|
||||
(name "r-copywriter")
|
||||
(version "2.6.0")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (bioconductor-uri "CopywriteR" version))
|
||||
(sha256
|
||||
(base32
|
||||
"1bwwnsyk7cpgwkagsnn5mv6fv233b0rkhjvbadrh70h8m4anawfj"))))
|
||||
(properties `((upstream-name . "CopywriteR")))
|
||||
(build-system r-build-system)
|
||||
(propagated-inputs
|
||||
`(("r-biocparallel" ,r-biocparallel)
|
||||
("r-chipseq" ,r-chipseq)
|
||||
("r-copyhelper" ,r-copyhelper)
|
||||
("r-data-table" ,r-data-table)
|
||||
("r-dnacopy" ,r-dnacopy)
|
||||
("r-futile-logger" ,r-futile-logger)
|
||||
("r-genomeinfodb" ,r-genomeinfodb)
|
||||
("r-genomicalignments" ,r-genomicalignments)
|
||||
("r-genomicranges" ,r-genomicranges)
|
||||
("r-gtools" ,r-gtools)
|
||||
("r-iranges" ,r-iranges)
|
||||
("r-matrixstats" ,r-matrixstats)
|
||||
("r-rsamtools" ,r-rsamtools)
|
||||
("r-s4vectors" ,r-s4vectors)))
|
||||
(home-page "https://github.com/PeeperLab/CopywriteR")
|
||||
(synopsis "Copy number information from targeted sequencing")
|
||||
(description
|
||||
"CopywriteR extracts DNA copy number information from targeted sequencing
|
||||
by utilizing off-target reads. It allows for extracting uniformly distributed
|
||||
copy number information, can be used without reference, and can be applied to
|
||||
sequencing data obtained from various techniques including chromatin
|
||||
immunoprecipitation and target enrichment on small gene panels. Thereby,
|
||||
CopywriteR constitutes a widely applicable alternative to available copy
|
||||
number detection tools.")
|
||||
(license license:gpl2)))
|
||||
|
||||
@@ -2,7 +2,7 @@
|
||||
;;; Copyright © 2014 Taylan Ulrich Bayirli/Kammer <taylanbayirli@gmail.com>
|
||||
;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
|
||||
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
|
||||
;;; Copyright © 2016, 2017 Efraim Flashner <efraim@flashner.co.il>
|
||||
;;; Copyright © 2016 Tomáš Čech <sleep_walker@gnu.org>
|
||||
;;; Copyright © 2016 Tobias Geerinckx-Rice <me@tobias.gr>
|
||||
;;;
|
||||
@@ -214,7 +214,7 @@ interface, for the Transmission BitTorrent daemon.")
|
||||
(define-public aria2
|
||||
(package
|
||||
(name "aria2")
|
||||
(version "1.29.0")
|
||||
(version "1.30.0")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "https://github.com/tatsuhiro-t/aria2/"
|
||||
@@ -222,7 +222,7 @@ interface, for the Transmission BitTorrent daemon.")
|
||||
name "-" version ".tar.xz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0bn8j6yhjnsxlxr1cdxw39gphvsrk3qhvvq92rsirxjvwwix0r0s"))))
|
||||
"1xiiqk4yiqr0c4hf05zkma9if13lp3wh37z1r0w60ahxs5k56v5z"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
`(#:configure-flags (list "--enable-libaria2"
|
||||
@@ -237,7 +237,8 @@ interface, for the Transmission BitTorrent daemon.")
|
||||
(string-append "// " text)))
|
||||
(substitute* "test/LpdMessageReceiverTest.cc"
|
||||
(("CPPUNIT_TEST_SUITE_REGISTRATION\\(LpdMessageReceiverTest\\);" text)
|
||||
(string-append "// " text))))))))
|
||||
(string-append "// " text)))
|
||||
#t)))))
|
||||
(native-inputs
|
||||
`(("cppunit" ,cppunit) ; for the tests
|
||||
("pkg-config" ,pkg-config)))
|
||||
|
||||
@@ -174,6 +174,7 @@ successful, or false to signal an error."
|
||||
((string=? system "arm-eabi") "no-ld.so")
|
||||
((string=? system "xtensa-elf") "no-ld.so")
|
||||
((string=? system "avr") "no-ld.so")
|
||||
((string=? system "propeller-elf") "no-ld.so")
|
||||
((string=? system "i686-mingw") "no-ld.so")
|
||||
|
||||
(else (error "dynamic linker name not known for this system"
|
||||
|
||||
@@ -30,7 +30,7 @@
|
||||
(define-public busybox
|
||||
(package
|
||||
(name "busybox")
|
||||
(version "1.25.0")
|
||||
(version "1.26.0")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
@@ -38,7 +38,7 @@
|
||||
version ".tar.bz2"))
|
||||
(sha256
|
||||
(base32
|
||||
"1z52mh6prhd6v47qryz4rvng5r1z0am6masrnigq06zfhmlf03ss"))))
|
||||
"0k0g3hk58m99c2sfq97ngnixb2rv2wzyhv3z00lxaw78bqvjglis"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
`(#:phases
|
||||
@@ -65,14 +65,6 @@
|
||||
(substitute* "testsuite/pidof.tests"
|
||||
(("-s init") "-s $(cat /proc/1/comm)"))
|
||||
|
||||
(substitute* "testsuite/grep.tests"
|
||||
;; The subject of this test is buggy. It is known by upstream (fixed in git)
|
||||
;; So mark it with SKIP_KNOWN_BUGS like the others.
|
||||
;; Presumably it wasn't known at the time of release ...
|
||||
;; (It is strange that they release software which they know to have bugs)
|
||||
(("testing \"grep -w \\^str doesn't match str not at the beginning\"")
|
||||
"test x\"$SKIP_KNOWN_BUGS\" = x\"\" && testing \"grep -w ^str doesn't match str not at the beginning\""))
|
||||
|
||||
;; This test cannot possibly pass.
|
||||
;; It is trying to test that "which ls" returns "/bin/ls" when PATH is not set.
|
||||
;; However, this relies on /bin/ls existing. Which it does not in guix.
|
||||
|
||||
+33
-1
@@ -1,6 +1,6 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
|
||||
;;; Copyright © 2016, 2017 Ricardo Wurmus <rekado@elephly.net>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -24,6 +24,8 @@
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (guix build-system trivial)
|
||||
#:use-module (gnu packages bootstrap)
|
||||
#:use-module (gnu packages bison)
|
||||
#:use-module (gnu packages flex)
|
||||
#:use-module (gnu packages perl)
|
||||
#:use-module (gnu packages texinfo)
|
||||
#:use-module (gnu packages guile))
|
||||
@@ -128,3 +130,33 @@ standard.")
|
||||
(chmod port #o777)))
|
||||
#t)))
|
||||
(synopsis "Wrapper providing the 'cc' command for TCC")))
|
||||
|
||||
(define-public pcc
|
||||
(package
|
||||
(name "pcc")
|
||||
(version "20170109")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "http://pcc.ludd.ltu.se/ftp/pub/pcc/pcc-"
|
||||
version ".tgz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1p34w496095mi0473f815w6wbi57zxil106mg7pj6sg6gzpjcgww"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
`(#:phases
|
||||
(modify-phases %standard-phases
|
||||
(replace 'check
|
||||
(lambda _
|
||||
(zero? (system* "make" "-C" "cc/cpp" "test")))))))
|
||||
(native-inputs
|
||||
`(("bison" ,bison)
|
||||
("flex" ,flex)))
|
||||
(synopsis "Portable C compiler")
|
||||
(description
|
||||
"PCC is a portable C compiler. The project goal is to write a C99
|
||||
compiler while still keeping it small, simple, fast and understandable.")
|
||||
(home-page "http://pcc.ludd.ltu.se")
|
||||
;; PCC incorporates code under various BSD licenses; for new code bsd-2 is
|
||||
;; preferred. See http://pcc.ludd.ltu.se/licenses/ for more details.
|
||||
(license (list license:bsd-2 license:bsd-3))))
|
||||
|
||||
@@ -88,6 +88,7 @@ data units.")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (pypi-uri "khal" version))
|
||||
(patches (search-patches "khal-disable-failing-tests.patch"))
|
||||
(sha256
|
||||
(base32
|
||||
"03vy4dp9n43w51mwqjjy08dr5nj7wxqnb085visz3j43vzm42p1f"))))
|
||||
|
||||
@@ -28,14 +28,19 @@
|
||||
#:use-module ((guix licenses) #:select (lgpl2.1+ gpl2 gpl2+ gpl3+))
|
||||
#:use-module (guix build-system cmake)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (guix build-system glib-or-gtk)
|
||||
#:use-module (guix gexp)
|
||||
#:use-module (gnu packages)
|
||||
#:use-module (gnu packages acl)
|
||||
#:use-module (gnu packages audio)
|
||||
#:use-module (gnu packages bison)
|
||||
#:use-module (gnu packages compression)
|
||||
#:use-module (gnu packages flex)
|
||||
#:use-module (gnu packages gettext)
|
||||
#:use-module (gnu packages gtk)
|
||||
#:use-module (gnu packages glib)
|
||||
#:use-module (gnu packages man)
|
||||
#:use-module (gnu packages mp3)
|
||||
#:use-module (gnu packages ncurses)
|
||||
#:use-module (gnu packages elf)
|
||||
#:use-module (gnu packages pkg-config)
|
||||
@@ -328,12 +333,14 @@ from an audio CD.")
|
||||
(parano (assoc-ref inputs "cdparanoia"))
|
||||
(which (assoc-ref inputs "which"))
|
||||
(discid (assoc-ref inputs "cd-discid"))
|
||||
(flac (assoc-ref inputs "flac"))
|
||||
(out (assoc-ref outputs "out")))
|
||||
(define (wrap file)
|
||||
(wrap-program file
|
||||
`("PATH" ":" prefix
|
||||
(,(string-append out "/bin:"
|
||||
wget "/bin:"
|
||||
flac "/bin:"
|
||||
which "/bin:"
|
||||
vorbis "/bin:"
|
||||
discid "/bin:"
|
||||
@@ -349,6 +356,7 @@ from an audio CD.")
|
||||
("cdparanoia" ,cdparanoia)
|
||||
("cd-discid" ,cd-discid)
|
||||
("vorbis-tools" ,vorbis-tools)
|
||||
("flac" ,flac)
|
||||
|
||||
;; A couple of Python and Perl scripts are included.
|
||||
("python" ,python)
|
||||
@@ -395,3 +403,96 @@ for bootable CD-ROMs.
|
||||
Image data is written to standard output by default and all other
|
||||
information is written to standard error.")
|
||||
(license gpl2+)))
|
||||
|
||||
(define-public asunder
|
||||
(package
|
||||
(name "asunder")
|
||||
(version "2.8")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri
|
||||
(string-append "http://www.littlesvr.ca/asunder/releases/asunder-"
|
||||
version
|
||||
".tar.bz2"))
|
||||
(sha256
|
||||
(base32
|
||||
"1nq9kd4rd4k2kibf57gdbm0zw2gxa234vvvdhxkm8g5bhx5h3iyq"))))
|
||||
(build-system glib-or-gtk-build-system)
|
||||
(arguments
|
||||
'(#:out-of-source? #f
|
||||
#:phases (modify-phases %standard-phases
|
||||
(add-after 'install 'wrap
|
||||
(lambda* (#:key inputs outputs #:allow-other-keys)
|
||||
(let ((program (string-append (assoc-ref outputs "out")
|
||||
"/bin/asunder")))
|
||||
(define (bin-directory input-name)
|
||||
(string-append (assoc-ref inputs input-name) "/bin"))
|
||||
(wrap-program program
|
||||
`("PATH" ":" prefix
|
||||
,(map bin-directory (list "cdparanoia"
|
||||
"lame"
|
||||
"vorbis-tools"
|
||||
"flac"
|
||||
"opus-tools"
|
||||
"wavpack"))))))))))
|
||||
(native-inputs `(("intltool" ,intltool)
|
||||
("pkg-config" ,pkg-config)))
|
||||
;; TODO: Add the necessary packages for Musepack encoding.
|
||||
(inputs `(("gtk+-2" ,gtk+-2)
|
||||
("glib" ,glib)
|
||||
("libcddb" ,libcddb)
|
||||
("cdparanoia" ,cdparanoia)
|
||||
("lame" ,lame)
|
||||
("vorbis-tools" ,vorbis-tools)
|
||||
("flac" ,flac)
|
||||
("opus-tools" ,opus-tools)
|
||||
("wavpack" ,wavpack)))
|
||||
(home-page "http://www.littlesvr.ca/asunder/")
|
||||
(synopsis "Graphical audio CD ripper and encoder")
|
||||
(description
|
||||
"Asunder is a graphical audio CD ripper and encoder. It can save audio
|
||||
tracks as WAV, MP3, Ogg Vorbis, FLAC, Opus, Wavpack, and Musepack. It can use
|
||||
CDDB to name and tag each track automatically, and it allows for each track to
|
||||
be by a different artist. Asunder can encode to multiple formats in one
|
||||
session, and it can create M3U playlists.")
|
||||
(license gpl2)))
|
||||
|
||||
(define-public ripit
|
||||
(package
|
||||
(name "ripit")
|
||||
(version "3.9.0")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "http://www.suwald.com/ripit/ripit-"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0ap71x477jy9c4jiqazb3y45hxdxm3jbq24x05g3vjyqzigi4x1b"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
`(#:tests? #f ; No test suite.
|
||||
#:phases
|
||||
(modify-phases %standard-phases
|
||||
(delete 'configure)
|
||||
(add-after 'unpack 'patch-usr-bin-install
|
||||
(lambda* (#:key inputs outputs #:allow-other-keys)
|
||||
(substitute* "Makefile"
|
||||
(("/usr/bin/install") (string-append
|
||||
(assoc-ref inputs "coreutils")
|
||||
"/bin/install"))
|
||||
(("\\$\\(DESTDIR\\)/usr/local") (assoc-ref outputs "out"))
|
||||
(("../../etc") "etc")))))))
|
||||
(native-inputs
|
||||
`(("coreutils" ,coreutils)))
|
||||
(inputs
|
||||
`(("perl" ,perl)))
|
||||
(propagated-inputs
|
||||
`(("cdparanoia" ,cdparanoia)
|
||||
("flac" ,flac)
|
||||
("vorbis-tools" ,vorbis-tools)
|
||||
("wavpack" ,wavpack)
|
||||
("perl-cddb-get" ,perl-cddb-get)))
|
||||
(home-page "http://www.suwald.com/ripit/about.php")
|
||||
(synopsis "Command-line program to extract audio CDs")
|
||||
(description "RipIT is used to extract audio from CDs.")
|
||||
(license gpl2)))
|
||||
|
||||
@@ -73,7 +73,7 @@
|
||||
(define-public nss-certs
|
||||
(package
|
||||
(name "nss-certs")
|
||||
(version "3.27.2")
|
||||
(version "3.27.1")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (let ((version-with-underscores
|
||||
@@ -84,7 +84,7 @@
|
||||
"nss-" version ".tar.gz")))
|
||||
(sha256
|
||||
(base32
|
||||
"0945q9yyhax9lkhxs1bjlr5gwknpvhzsa4zxfh127l398i9ci2nw"))))
|
||||
"0sraxk26swlgl7rl742rkfp5k251v5z3lqw9k8ikin0cjfhkfdpx"))))
|
||||
(build-system gnu-build-system)
|
||||
(outputs '("out"))
|
||||
(native-inputs
|
||||
|
||||
+11
-5
@@ -1,7 +1,7 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
|
||||
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
|
||||
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
|
||||
;;; Copyright © 2016, 2017 Mathieu Lirzin <mthl@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -186,8 +186,8 @@ their dependencies.")
|
||||
(license l:gpl3+))))
|
||||
|
||||
(define-public cuirass
|
||||
(let ((commit "cbdb59af8e7a1b40d687f80e62c5892686d384d2")
|
||||
(revision "2"))
|
||||
(let ((commit "d0a5801e397335bb44d8033e5deddf02c1cc99c2")
|
||||
(revision "3"))
|
||||
(package
|
||||
(name "cuirass")
|
||||
(version (string-append "0.0.1-" revision "." (string-take commit 7)))
|
||||
@@ -199,12 +199,18 @@ their dependencies.")
|
||||
(file-name (string-append name "-" version))
|
||||
(sha256
|
||||
(base32
|
||||
"0qmhchazg8wyrfn6d2im4jg7d52gb0xp8afjan5szl3bpphi4s28"))))
|
||||
"0sa94dgp9w6av7i0a570fv9a9yq03jkxdrm5d75h6szsp1kiyw2i"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
'(#:phases
|
||||
(modify-phases %standard-phases
|
||||
(add-after 'unpack 'bootstrap
|
||||
(add-after 'unpack 'disable-repo-tests
|
||||
(λ _
|
||||
;; Disable tests that use a connection to the Guix daemon.
|
||||
(substitute* "Makefile.am"
|
||||
(("tests/repo.scm \\\\") "\\"))
|
||||
#t))
|
||||
(add-before 'configure 'bootstrap
|
||||
(lambda _ (zero? (system* "sh" "bootstrap"))))
|
||||
(add-after 'install 'wrap-program
|
||||
(lambda* (#:key inputs outputs #:allow-other-keys)
|
||||
|
||||
@@ -92,14 +92,14 @@ highlighting your own code that seemed comprehensible when you wrote it.")
|
||||
(define-public global ; a global variable
|
||||
(package
|
||||
(name "global")
|
||||
(version "6.5.5")
|
||||
(version "6.5.6")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnu/global/global-"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0yyg91qw8399lnxfai4bxkh9yq71qdwp9kvadgzp05cdqni44nxw"))))
|
||||
"018m536k5y6lks1a6gqn3bsp7r8zk017znqj9kva1nm8d7x9lbqj"))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs `(("ncurses" ,ncurses)
|
||||
("libltdl" ,libltdl)
|
||||
|
||||
@@ -474,7 +474,7 @@ the bootstrap environment."
|
||||
(unsetenv "CPATH")
|
||||
|
||||
;; Tell 'libpthread' where to find 'libihash' on Hurd systems.
|
||||
,@(if (string-match "i586-gnu" (%current-system))
|
||||
,@(if (hurd-triplet? (%current-system))
|
||||
`((substitute* "libpthread/Makefile"
|
||||
(("LDLIBS-pthread.so =.*")
|
||||
(string-append "LDLIBS-pthread.so = "
|
||||
@@ -499,7 +499,7 @@ the bootstrap environment."
|
||||
,@%boot1-inputs
|
||||
|
||||
;; A native MiG is needed to build Glibc on Hurd.
|
||||
,@(if (string-match "i586-gnu" (%current-system))
|
||||
,@(if (hurd-triplet? (%current-system))
|
||||
`(("mig" ,mig-boot0))
|
||||
'())
|
||||
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2012, 2013, 2014, 2015, 2017 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
|
||||
;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
|
||||
;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
|
||||
@@ -57,8 +57,8 @@
|
||||
(method url-fetch)
|
||||
(uri (list (string-append "http://zlib.net/zlib-"
|
||||
version ".tar.gz")
|
||||
(string-append "mirror://sourceforge/libpng/zlib-"
|
||||
version ".tar.gz")))
|
||||
(string-append "mirror://sourceforge/libpng/zlib/"
|
||||
version "/zlib-" version ".tar.gz")))
|
||||
(sha256
|
||||
(base32
|
||||
"039agw5rqvqny92cpkrfn243x2gd4xn13hs3xi6isk55d2vqqr9n"))))
|
||||
|
||||
@@ -1,5 +1,7 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
|
||||
;;; Copyright © 2017 Mathieu OTHACEHE <m.othacehe@gmail.com>
|
||||
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -28,7 +30,9 @@
|
||||
#:use-module (gnu packages glib)
|
||||
#:use-module (gnu packages linux)
|
||||
#:use-module (gnu packages pkg-config)
|
||||
#:use-module (gnu packages polkit)
|
||||
#:use-module (gnu packages python)
|
||||
#:use-module (gnu packages qt)
|
||||
#:use-module (gnu packages readline)
|
||||
#:use-module (gnu packages samba)
|
||||
#:use-module (gnu packages tls)
|
||||
@@ -50,7 +54,7 @@
|
||||
(arguments
|
||||
`(#:configure-flags
|
||||
(list "--enable-nmcompat"
|
||||
;; "--enable-polkit"
|
||||
"--enable-polkit"
|
||||
"--enable-openconnect"
|
||||
"--enable-openvpn"
|
||||
"--enable-vpnc"
|
||||
@@ -71,7 +75,7 @@
|
||||
("glib" ,glib)
|
||||
("gnutls" ,gnutls)
|
||||
("iptables" ,iptables)
|
||||
;; ("polkit" ,polkit) ; pkg-config cannot find polkit.pc
|
||||
("polkit" ,polkit) ;so connman can be used by unprivileged users
|
||||
("readline" ,readline)
|
||||
;; These inputs are needed for connman to include the interface to
|
||||
;; these technologies so IF they are installed they can be used.
|
||||
@@ -120,9 +124,50 @@ sharing) to clients via USB, ethernet, WiFi, cellular and Bluetooth.")
|
||||
(inputs
|
||||
`(("efl" ,efl)
|
||||
("python-2" ,python-2)
|
||||
("python2-dbus" ,python2-dbus)
|
||||
("python2-efl" ,python2-efl)))
|
||||
(home-page "https://www.enlightenment.org")
|
||||
(synopsis "Connman User Interface written using the EFL")
|
||||
(description
|
||||
"An EFL user interface for the @code{connman} connection manager.")
|
||||
(license lgpl3)))
|
||||
|
||||
(define-public cmst
|
||||
(package
|
||||
(name "cmst")
|
||||
(version "2016.10.03")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
"https://github.com/andrew-bibb/cmst/releases/download/cmst-"
|
||||
version "/cmst-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32 "1xpn4sqnxzpsjjwh9hva9sn55xlryiz2f2mwpyj2l31janj7a082"))))
|
||||
(inputs
|
||||
`(("qt" ,qt)))
|
||||
(native-inputs
|
||||
`(("qmake" ,qt)))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
'(#:phases
|
||||
(modify-phases %standard-phases
|
||||
(replace 'configure
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(zero?
|
||||
(system* "qmake"
|
||||
(string-append "PREFIX="
|
||||
(assoc-ref outputs "out"))))))
|
||||
(add-before 'install 'fix-Makefiles
|
||||
(lambda* (#:key inputs outputs #:allow-other-keys)
|
||||
(let ((out (assoc-ref outputs "out")))
|
||||
(substitute* (find-files "." "Makefile")
|
||||
(("INSTALL_ROOT)")
|
||||
(string-append "INSTALL_ROOT)" out))
|
||||
(("/usr/bin") "/bin"))))))))
|
||||
(home-page "https://github.com/andrew-bibb/cmst")
|
||||
(synopsis "Qt frontend for Connman")
|
||||
(description
|
||||
"Cmst is a Qt based frontend for the @code{connman} connection manager.
|
||||
This package also provides a systemtray icon.")
|
||||
(license x11)))
|
||||
|
||||
@@ -468,7 +468,7 @@ XBINUTILS and the cross tool chain."
|
||||
|
||||
(native-inputs `(("cross-gcc" ,xgcc)
|
||||
("cross-binutils" ,xbinutils)
|
||||
,@(if (string-match (or "i586-pc-gnu" "i586-gnu") target)
|
||||
,@(if (hurd-triplet? target)
|
||||
`(("cross-mig"
|
||||
,@(assoc-ref (package-native-inputs xheaders)
|
||||
"cross-mig")))
|
||||
|
||||
@@ -40,7 +40,7 @@
|
||||
(define-public curl
|
||||
(package
|
||||
(name "curl")
|
||||
(replacement curl-7.51.0)
|
||||
(replacement curl-7.52.1)
|
||||
(version "7.50.3")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
@@ -119,17 +119,17 @@ authentication (Basic, Digest, NTLM, Negotiate, kerberos...), proxy
|
||||
tunneling, and so on.")
|
||||
(license (license:non-copyleft "file://COPYING"
|
||||
"See COPYING in the distribution."))
|
||||
(home-page "http://curl.haxx.se/")))
|
||||
(home-page "https://curl.haxx.se/")))
|
||||
|
||||
(define curl-7.51.0
|
||||
(define curl-7.52.1
|
||||
(package
|
||||
(inherit curl)
|
||||
(source
|
||||
(let ((version "7.51.0"))
|
||||
(let ((version "7.52.1"))
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "https://curl.haxx.se/download/curl-"
|
||||
version ".tar.lzma"))
|
||||
(sha256
|
||||
(base32
|
||||
"0605f28m2kxjcxrcfcv1ja353gv167lwyxjc3xizqbwppdmmzvwy")))))))
|
||||
"0r937wplchjxifxqqcjxd9rzp6l9rqqdfjn41x1y4djrh95nsa24")))))))
|
||||
|
||||
@@ -210,7 +210,7 @@ SQL, Key/Value, XML/XQuery or Java Object storage for their data model.")
|
||||
(define-public mysql
|
||||
(package
|
||||
(name "mysql")
|
||||
(version "5.7.16")
|
||||
(version "5.7.17")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (list (string-append
|
||||
@@ -222,7 +222,7 @@ SQL, Key/Value, XML/XQuery or Java Object storage for their data model.")
|
||||
name "-" version ".tar.gz")))
|
||||
(sha256
|
||||
(base32
|
||||
"198qhd9bdm0fnpp307mgby2aar92yzya0937kxi7bcpdfjcvada9"))))
|
||||
"0lcn9cm36n14g22bcppq5vf4nxbrl3khvlsp9hsixqdfb3l27gyf"))))
|
||||
(build-system cmake-build-system)
|
||||
(arguments
|
||||
`(#:configure-flags
|
||||
@@ -285,7 +285,7 @@ Language.")
|
||||
(define-public mariadb
|
||||
(package
|
||||
(name "mariadb")
|
||||
(version "10.1.19")
|
||||
(version "10.1.20")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "https://downloads.mariadb.org/f/"
|
||||
@@ -293,7 +293,7 @@ Language.")
|
||||
name "-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"108s4mimdbmgmmn5pcr9a405j70cyny9adzv49s75lg22krp74sv"))))
|
||||
"1fd0kfw94iyprf0466kjw5mwmj4ky0i997lz6499jkb79pr86kn2"))))
|
||||
(build-system cmake-build-system)
|
||||
(arguments
|
||||
'(#:configure-flags
|
||||
|
||||
@@ -54,13 +54,13 @@ clients.")
|
||||
(define-public vdirsyncer
|
||||
(package
|
||||
(name "vdirsyncer")
|
||||
(version "0.14.0")
|
||||
(version "0.14.1")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (pypi-uri name version))
|
||||
(sha256
|
||||
(base32
|
||||
"1mbh2gykx9sqsnyfa962ifxksx4afl2lb9rcsbd6rsh3gj2il898"))))
|
||||
"044f01fjd8dpz4y9dm3qcc1a8cihcxxbr1sz6y6fkvglpb6k85y5"))))
|
||||
(build-system python-build-system)
|
||||
(arguments
|
||||
`(#:phases (modify-phases %standard-phases
|
||||
|
||||
@@ -235,7 +235,7 @@ create smooth, animated user interfaces.")
|
||||
#:tests? #f))
|
||||
|
||||
;; This used to be at <http://slim.berlios.de/>.
|
||||
(home-page "http://sourceforge.net/projects/slim.berlios/")
|
||||
(home-page "https://sourceforge.net/projects/slim.berlios/")
|
||||
(synopsis "Desktop-independent graphical login manager for X11")
|
||||
(description
|
||||
"SLiM is a Desktop-independent graphical login manager for X11, derived
|
||||
|
||||
+14
-10
@@ -140,7 +140,7 @@ high-volume and high-reliability applications. The name BIND stands for
|
||||
(define-public dnscrypt-proxy
|
||||
(package
|
||||
(name "dnscrypt-proxy")
|
||||
(version "1.7.0")
|
||||
(version "1.8.1")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
@@ -148,7 +148,7 @@ high-volume and high-reliability applications. The name BIND stands for
|
||||
"dnscrypt-proxy-" version ".tar.bz2"))
|
||||
(sha256
|
||||
(base32
|
||||
"1qw2nib0d5ia8581lbdnjxgn9c7pf2qw8vhpnnh1wjcjj3gpgbqx"))
|
||||
"1dz0knslf7ysc2xx33ljrdlqyr4b0fpm9ifrwvwgcjaxgh94l7m8"))
|
||||
(modules '((guix build utils)))
|
||||
(snippet
|
||||
;; Delete bundled libltdl. XXX: This package also bundles
|
||||
@@ -261,15 +261,17 @@ asynchronous fashion.")
|
||||
(define-public yadifa
|
||||
(package
|
||||
(name "yadifa")
|
||||
(version "2.2.1-6281")
|
||||
(version "2.2.3")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "http://cdn.yadifa.eu/sites/default/files/releases/"
|
||||
name "-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0vj71z7i9lfbnp93k28aplwldp5mfli0kvrbwmha6fjha6kcr910"))))
|
||||
(let ((revision "6711"))
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri
|
||||
(string-append "http://cdn.yadifa.eu/sites/default/files/releases/"
|
||||
name "-" version "-" revision ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0ikfm40gx0zjw3gnxsw3rn1k4wb8jacgklja3ygcj1knq6hy2zaa")))))
|
||||
(build-system gnu-build-system)
|
||||
(native-inputs
|
||||
`(("which" ,which)))
|
||||
@@ -283,6 +285,8 @@ asynchronous fashion.")
|
||||
#:configure-flags (list "--sysconfdir=/etc" "--localstatedir=/var"
|
||||
"--enable-shared" "--disable-static"
|
||||
"--enable-messages" "--enable-ctrl"
|
||||
"--enable-nsec" "--enable-nsec3"
|
||||
"--enable-tsig" "--enable-caching"
|
||||
;; NSID is a rarely-used debugging aid, that also
|
||||
;; causes the build to fail. Just disable it.
|
||||
"--disable-nsid")))
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2015, 2016 Andreas Enge <andreas@enge.fr>
|
||||
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
|
||||
;;; Copyright © 2016 Alex Griffin <a@ajgrf.com>
|
||||
;;; Copyright © 2016, 2017 Alex Griffin <a@ajgrf.com>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -61,7 +61,7 @@
|
||||
(define-public calibre
|
||||
(package
|
||||
(name "calibre")
|
||||
(version "2.74.0")
|
||||
(version "2.76.0")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
@@ -70,7 +70,7 @@
|
||||
version ".tar.xz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1dpz1682zd8anvgafk2m5m123dxy1bc07ysj0z1my7zqaq1cyrm3"))
|
||||
"1xfm586n6gm44mkyn25mbiyhj6w9ji9yl6fvmnr4zk1q6qcga3v8"))
|
||||
;; Remove non-free or doubtful code, see
|
||||
;; https://lists.gnu.org/archive/html/guix-devel/2015-02/msg00478.html
|
||||
(modules '((guix build utils)))
|
||||
|
||||
+44
-18
@@ -2,7 +2,7 @@
|
||||
;;; Copyright © 2014 Taylan Ulrich Bayirli/Kammer <taylanbayirli@gmail.com>
|
||||
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2014, 2015, 2016 Mark H Weaver <mhw@netris.org>
|
||||
;;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com>
|
||||
;;; Copyright © 2014, 2015, 2016, 2017 Alex Kost <alezost@gmail.com>
|
||||
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
|
||||
;;; Copyright © 2015, 2016 Ricardo Wurmus <rekado@elephly.net>
|
||||
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
|
||||
@@ -398,7 +398,7 @@ configuration files, such as .gitattributes, .gitignore, and .git/config.")
|
||||
(define-public emacs-with-editor
|
||||
(package
|
||||
(name "emacs-with-editor")
|
||||
(version "2.5.8")
|
||||
(version "2.5.9")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
@@ -407,7 +407,7 @@ configuration files, such as .gitattributes, .gitignore, and .git/config.")
|
||||
(file-name (string-append name "-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1dghd0m5zwayv553g4cr990s4ig5lyh0b52qfdv5rbqnndpj3cjn"))))
|
||||
"0znfznyqr360ryi7za9szbz1l5236v2cig25s4k7kkw0w8828xzh"))))
|
||||
(build-system emacs-build-system)
|
||||
(propagated-inputs
|
||||
`(("emacs-dash" ,emacs-dash)))
|
||||
@@ -423,7 +423,7 @@ on stdout instead of using a socket as the Emacsclient does.")
|
||||
(define-public magit
|
||||
(package
|
||||
(name "magit")
|
||||
(version "2.8.0")
|
||||
(version "2.10.0")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
@@ -431,7 +431,7 @@ on stdout instead of using a socket as the Emacsclient does.")
|
||||
version "/" name "-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1znvb7inwinrhifqzwp4lp9j6yp1l25j7riczc0zmvcjbpl5yhfq"))))
|
||||
"1w74vy46z922kfs7gjkrng7wjpi481calpasqmjzpn3hqvgsd5d1"))))
|
||||
(build-system gnu-build-system)
|
||||
(native-inputs `(("texinfo" ,texinfo)
|
||||
("emacs" ,emacs-minimal)))
|
||||
@@ -559,7 +559,7 @@ support for Git-SVN.")
|
||||
(file-name (string-append "magit-popup-" version ".el"))
|
||||
(sha256
|
||||
(base32
|
||||
"0lmw824zp8c0vhikfkiay9wn4nmaksz6mfy0fldvy4wlx5c26yh3"))))
|
||||
"0s04jnskmggwn69ln05qfwwa32va0q5ri7dwx917wkqz17w5zi62"))))
|
||||
(build-system emacs-build-system)
|
||||
(propagated-inputs
|
||||
`(("emacs-dash" ,emacs-dash)))
|
||||
@@ -1248,7 +1248,7 @@ and stored in memory.")
|
||||
(define-public emacs-bui
|
||||
(package
|
||||
(name "emacs-bui")
|
||||
(version "1.0.1")
|
||||
(version "1.1.0")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
@@ -1257,7 +1257,7 @@ and stored in memory.")
|
||||
(file-name (string-append name "-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0vsh1v99xxm6hhqp0vg9fbs230kawa7xb5dnd8fidf3vwm622aqh"))))
|
||||
"112k0mq6xpy0r47vk66miw7rxbkv3d06pv3pd0vcmrhcnhnnk486"))))
|
||||
(build-system emacs-build-system)
|
||||
(propagated-inputs
|
||||
`(("dash" ,emacs-dash)))
|
||||
@@ -1272,7 +1272,7 @@ type, for example: packages, buffers, files, etc.")
|
||||
(define-public emacs-guix
|
||||
(package
|
||||
(name "emacs-guix")
|
||||
(version "0.2")
|
||||
(version "0.2.2")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "https://github.com/alezost/guix.el"
|
||||
@@ -1280,7 +1280,7 @@ type, for example: packages, buffers, files, etc.")
|
||||
"/emacs-guix-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0h168597am5vcix149l27g876v4f5yqwx8v0s9mmsdva1qqcq5s5"))))
|
||||
"1i47yh24xvgmnc778765g3j9ip0xb2y85v6w83r4qmkigk9rl2ck"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
`(#:configure-flags
|
||||
@@ -1316,10 +1316,10 @@ type, for example: packages, buffers, files, etc.")
|
||||
(home-page "https://github.com/alezost/guix.el")
|
||||
(synopsis "Emacs interface for GNU Guix")
|
||||
(description
|
||||
"Emacs-Guix provides a visual interface, tools and features for the
|
||||
GNU Guix package manager. Particularly, it allows you to do various
|
||||
package management tasks from Emacs. To begin with, run @code{M-x
|
||||
guix-help} command.")
|
||||
"Emacs-Guix provides a visual interface, tools and features for the GNU
|
||||
Guix package manager. Particularly, it allows you to do various package
|
||||
management tasks from Emacs. To begin with, run @code{M-x guix-about} or
|
||||
@code{M-x guix-help} command.")
|
||||
(license license:gpl3+)))
|
||||
|
||||
(define-public emacs-d-mode
|
||||
@@ -1414,6 +1414,32 @@ strings.")
|
||||
files and directories.")
|
||||
(license license:gpl3+)))
|
||||
|
||||
(define-public emacs-git-gutter
|
||||
(package
|
||||
(name "emacs-git-gutter")
|
||||
(version "0.90")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
"https://github.com/syohex/" name "/archive/"
|
||||
version ".tar.gz"))
|
||||
(file-name (string-append name "-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1nmhvhpq1l56mj2yq3ag23rw3x4xgnsy8szp30s26l0yjnkhc4qg"))))
|
||||
(build-system emacs-build-system)
|
||||
(home-page "https://github.com/syohex/emacs-git-gutter")
|
||||
(synopsis "See and manage hunks of text in a version control system")
|
||||
(description
|
||||
"This package is an Emacs minor mode for displaying and interacting with
|
||||
hunks of text managed in a version control system. Added modified and deleted
|
||||
areas can be indicated with symbols on the edge of the buffer, and commands
|
||||
can be used to move between and perform actions on these hunks.
|
||||
|
||||
Git, Mercurial, Subversion and Bazaar are supported, and many parts of the
|
||||
display and behaviour is easily customisable.")
|
||||
(license license:gpl3+)))
|
||||
|
||||
(define-public emacs-el-mock
|
||||
(package
|
||||
(name "emacs-el-mock")
|
||||
@@ -2303,7 +2329,7 @@ dark background.")
|
||||
(define-public emacs-smartparens
|
||||
(package
|
||||
(name "emacs-smartparens")
|
||||
(version "1.8.0")
|
||||
(version "1.9.0")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
@@ -2312,7 +2338,7 @@ dark background.")
|
||||
(file-name (string-append name "-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0xsqiklg0q4w6gj0js1hvsz4lkypvcx6c9kzb1mz232gwlqx1azw"))))
|
||||
"12065r7h1s9v8lnq5mk3654dkw4cq60ky8aniqq5n2ivv6qd2d4q"))))
|
||||
(build-system emacs-build-system)
|
||||
(propagated-inputs `(("emacs-dash" ,emacs-dash)))
|
||||
(home-page "https://github.com/Fuco1/smartparens")
|
||||
@@ -3266,14 +3292,14 @@ passive voice.")
|
||||
(define-public emacs-org
|
||||
(package
|
||||
(name "emacs-org")
|
||||
(version "20161214")
|
||||
(version "20161224")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "http://elpa.gnu.org/packages/org-"
|
||||
version ".tar"))
|
||||
(sha256
|
||||
(base32
|
||||
"0pa9d0l6axif5wlzi7lvxl0fpjwwvc79cy9d37z7md4hxyjdvwzm"))))
|
||||
"0b10bjypn0w5ja776f8sxl1qpvb61iyz1n3c74jx6fqwypv7dmgi"))))
|
||||
(build-system emacs-build-system)
|
||||
(home-page "http://orgmode.org/")
|
||||
(synopsis "Outline-based notes management and organizer")
|
||||
|
||||
+351
-1
@@ -1,5 +1,5 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
|
||||
;;; Copyright © 2016, 2017 Ricardo Wurmus <rekado@elephly.net>
|
||||
;;; Copyright © 2016 Theodoros Foradis <theodoros.for@openmailbox.org>
|
||||
;;; Copyright © 2016 David Craven <david@craven.ch>
|
||||
;;;
|
||||
@@ -30,7 +30,9 @@
|
||||
#:use-module (guix build utils)
|
||||
#:use-module (gnu packages)
|
||||
#:use-module (gnu packages autotools)
|
||||
#:use-module (gnu packages bison)
|
||||
#:use-module (gnu packages cross-base)
|
||||
#:use-module (gnu packages dejagnu)
|
||||
#:use-module (gnu packages flex)
|
||||
#:use-module (gnu packages gcc)
|
||||
#:use-module (gnu packages gdb)
|
||||
@@ -369,3 +371,351 @@ language.")
|
||||
(description "OpenOCD provides on-chip programming and debugging support
|
||||
with a layered architecture of JTAG interface and TAP support.")
|
||||
(license license:gpl2+))))
|
||||
|
||||
;; The commits for all propeller tools are the latest versions as published
|
||||
;; here: https://github.com/dbetz/propeller-gcc
|
||||
|
||||
(define propeller-binutils
|
||||
(let ((xbinutils (cross-binutils "propeller-elf"))
|
||||
(commit "3bfba30076f8ce160a2f42914fdb68f24445fd44")
|
||||
(revision "1"))
|
||||
(package
|
||||
(inherit xbinutils)
|
||||
(name "propeller-binutils")
|
||||
(version (string-append "0.0.0-" revision "." (string-take commit 9)))
|
||||
(source (origin (inherit (package-source xbinutils))
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
(url "https://github.com/totalspectrum/binutils-propeller.git")
|
||||
(commit commit)))
|
||||
(file-name (string-append name "-" commit "-checkout"))
|
||||
(sha256
|
||||
(base32
|
||||
"1v3rgxwj7b8817wy5ccf8621v75qcxvcxygk4acr3hbc6yqybr8h"))))
|
||||
(arguments
|
||||
`(;; FIXME: For some reason there are many test failures. Some of them
|
||||
;; appear to be due to regular expression mismatch, but it's not
|
||||
;; obvious how to fix the failures.
|
||||
#:tests? #f
|
||||
#:phases
|
||||
(modify-phases %standard-phases
|
||||
(add-after 'unpack 'patch-/bin/sh-in-tests
|
||||
(lambda _
|
||||
(substitute* '("sim/testsuite/Makefile.in"
|
||||
"sim/testsuite/mips64el-elf/Makefile.in"
|
||||
"sim/testsuite/d10v-elf/Makefile.in"
|
||||
"sim/testsuite/sim/cris/asm/badarch1.ms")
|
||||
(("/bin/sh") (which "sh")))
|
||||
#t)))
|
||||
,@(package-arguments xbinutils)))
|
||||
(native-inputs
|
||||
`(("bison" ,bison)
|
||||
("flex" ,flex)
|
||||
("texinfo" ,texinfo)
|
||||
("dejagnu" ,dejagnu)
|
||||
,@(package-native-inputs xbinutils))))))
|
||||
|
||||
(define-public propeller-gcc
|
||||
(let ((xgcc (cross-gcc "propeller-elf"
|
||||
propeller-binutils))
|
||||
(commit "b4f45a4725e0b6d0af59e594c4e3e35ca4105867")
|
||||
(revision "1"))
|
||||
(package (inherit xgcc)
|
||||
(name "propeller-gcc")
|
||||
(version (string-append "6.0.0-" revision "." (string-take commit 9)))
|
||||
(source (origin
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
(url "https://github.com/totalspectrum/gcc-propeller.git")
|
||||
(commit commit)))
|
||||
(file-name (string-append name "-" commit "-checkout"))
|
||||
(sha256
|
||||
(base32
|
||||
"0d9kdxm2fzanjqa7q5850kzbsfl0fqyaahxn74h6nkxxacwa11zb"))
|
||||
(patches
|
||||
(append
|
||||
(origin-patches (package-source gcc-6))
|
||||
(search-patches "gcc-cross-environment-variables.patch")))))
|
||||
(native-inputs
|
||||
`(("flex" ,flex)
|
||||
,@(package-native-inputs xgcc)))
|
||||
;; All headers and cross libraries of the propeller toolchain are
|
||||
;; installed under the "propeller-elf" prefix.
|
||||
(native-search-paths
|
||||
(list (search-path-specification
|
||||
(variable "CROSS_C_INCLUDE_PATH")
|
||||
(files '("propeller-elf/include")))
|
||||
(search-path-specification
|
||||
(variable "CROSS_LIBRARY_PATH")
|
||||
(files '("propeller-elf/lib")))))
|
||||
(home-page "https://github.com/totalspectrum/gcc-propeller")
|
||||
(synopsis "GCC for the Parallax Propeller"))))
|
||||
|
||||
;; There is no release, so we take the latest version as referenced from here:
|
||||
;; https://github.com/dbetz/propeller-gcc
|
||||
(define-public proplib
|
||||
(let ((commit "844741fe0ceb140ab2fdf9d0667f68c1c39c31da")
|
||||
(revision "1"))
|
||||
(package
|
||||
(name "proplib")
|
||||
(version (string-append "0.0.0-" revision "." (string-take commit 9)))
|
||||
(source (origin
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
(url "https://github.com/totalspectrum/proplib.git")
|
||||
(commit commit)))
|
||||
(file-name (string-append name "-" commit "-checkout"))
|
||||
(sha256
|
||||
(base32
|
||||
"0q7irf1x8iqx07n7lzksax9armrdkizs49swsz76nbks0mw67wiv"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
`(#:tests? #f ; no tests
|
||||
#:make-flags
|
||||
(list (string-append "PREFIX=" (assoc-ref %outputs "out"))
|
||||
(string-append "BUILD=" (getcwd) "/build"))
|
||||
#:phases
|
||||
(modify-phases %standard-phases
|
||||
(delete 'configure)
|
||||
(add-after 'unpack 'fix-Makefile
|
||||
(lambda _
|
||||
(substitute* "Makefile"
|
||||
;; The GCC sources are not part of this package, so we cannot
|
||||
;; install the out-of-tree license file.
|
||||
(("cp \\.\\..*") "")
|
||||
;; Control the installation time of the headers.
|
||||
((" install-includes") ""))
|
||||
#t))
|
||||
;; The Makefile does not separate building from installation, so we
|
||||
;; have to create the target directories at build time.
|
||||
(add-before 'build 'create-target-directories
|
||||
(lambda* (#:key make-flags #:allow-other-keys)
|
||||
(zero? (apply system* "make" "install-dirs" make-flags))))
|
||||
(add-before 'build 'set-cross-environment-variables
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(setenv "CROSS_LIBRARY_PATH"
|
||||
(string-append (assoc-ref outputs "out")
|
||||
"/propeller-elf/lib:"
|
||||
(or (getenv "CROSS_LIBRARY_PATH") "")))
|
||||
(setenv "CROSS_C_INCLUDE_PATH"
|
||||
(string-append (assoc-ref outputs "out")
|
||||
"/propeller-elf/include:"
|
||||
(or (getenv "CROSS_C_INCLUDE_PATH") "")))
|
||||
#t))
|
||||
(add-after 'build 'build-tiny
|
||||
(lambda* (#:key make-flags #:allow-other-keys)
|
||||
(zero? (apply system* "make" "tiny" make-flags))))
|
||||
;; The build of the tiny libraries depends on the includes to be
|
||||
;; available. Since we set CROSS_C_INCLUDE_PATH to the output
|
||||
;; directory, we have to install the includes first.
|
||||
(add-before 'build-tiny 'install-includes
|
||||
(lambda* (#:key make-flags #:allow-other-keys)
|
||||
(zero? (apply system* "make" "install-includes" make-flags))))
|
||||
(add-after 'install 'install-tiny
|
||||
(lambda* (#:key make-flags #:allow-other-keys)
|
||||
(zero? (apply system* "make" "install-tiny" make-flags)))))))
|
||||
(native-inputs
|
||||
`(("propeller-gcc" ,propeller-gcc)
|
||||
("propeller-binutils" ,propeller-binutils)
|
||||
("perl" ,perl)))
|
||||
(home-page "https://github.com/totalspectrum/proplib")
|
||||
(synopsis "C library for the Parallax Propeller")
|
||||
(description "This is a C library for the Parallax Propeller
|
||||
micro-controller.")
|
||||
;; Most of the code is released under the Expat license. Some of the
|
||||
;; included code is public domain and some changes are BSD licensed.
|
||||
(license license:expat))))
|
||||
|
||||
(define-public propeller-toolchain
|
||||
(package
|
||||
(name "propeller-toolchain")
|
||||
(version (package-version propeller-gcc))
|
||||
(source #f)
|
||||
(build-system trivial-build-system)
|
||||
(arguments '(#:builder (mkdir %output)))
|
||||
(propagated-inputs
|
||||
`(("binutils" ,propeller-binutils)
|
||||
("libc" ,proplib)
|
||||
("gcc" ,propeller-gcc)))
|
||||
(synopsis "Complete GCC tool chain for Propeller micro-controllers")
|
||||
(description "This package provides a complete GCC tool chain for
|
||||
Propeller micro-controller development.")
|
||||
(home-page (package-home-page propeller-gcc))
|
||||
(license (package-license propeller-gcc))))
|
||||
|
||||
(define-public openspin
|
||||
(package
|
||||
(name "openspin")
|
||||
(version "1.00.78")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "https://github.com/parallaxinc/"
|
||||
"OpenSpin/archive/" version ".tar.gz"))
|
||||
(file-name (string-append name "-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1k2dbz1v604g4r2d9qhckg2m8dnhiya760mbsqfsg4waxal87yb7"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
`(#:tests? #f ; no tests
|
||||
#:phases
|
||||
(modify-phases %standard-phases
|
||||
(delete 'configure)
|
||||
(add-after 'unpack 'remove-timestamp
|
||||
(lambda _
|
||||
(substitute* "SpinSource/openspin.cpp"
|
||||
((" Compiled on.*$") "\\n\");"))
|
||||
#t))
|
||||
;; Makefile does not include "install" target
|
||||
(replace 'install
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(let ((bin (string-append (assoc-ref outputs "out")
|
||||
"/bin")))
|
||||
(mkdir-p bin)
|
||||
(install-file "build/openspin" bin)
|
||||
#t))))))
|
||||
(home-page "https://github.com/parallaxinc/OpenSpin")
|
||||
(synopsis "Spin/PASM compiler for the Parallax Propeller")
|
||||
(description "OpenSpin is a compiler for the Spin/PASM language of the
|
||||
Parallax Propeller. It was ported from Chip Gracey's original x86 assembler
|
||||
code.")
|
||||
(license license:expat)))
|
||||
|
||||
(define-public propeller-load
|
||||
(let ((commit "ba9c0a7251cf751d8d292ae19ffa03132097c0c0")
|
||||
(revision "1"))
|
||||
(package
|
||||
(name "propeller-load")
|
||||
(version "3.4.0")
|
||||
(source (origin
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
(url "https://github.com/dbetz/propeller-load.git")
|
||||
(commit commit)))
|
||||
(file-name (string-append name "-" commit "-checkout"))
|
||||
(sha256
|
||||
(base32
|
||||
"1qv3xaapl9fmj3zn58b60sprp4rnvnlpci8ci0pdrzkw6fhvx3pg"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
`(#:tests? #f ; no tests
|
||||
#:make-flags
|
||||
(list "OS=linux"
|
||||
(string-append "TARGET=" (assoc-ref %outputs "out")))
|
||||
#:phases
|
||||
(modify-phases %standard-phases
|
||||
(delete 'configure))))
|
||||
(native-inputs
|
||||
`(("openspin" ,openspin)
|
||||
("propeller-toolchain" ,propeller-toolchain)))
|
||||
(home-page "https://github.com/dbetz/propeller-load")
|
||||
(synopsis "Loader for Parallax Propeller micro-controllers")
|
||||
(description "This package provides the tool @code{propeller-load} to
|
||||
upload binaries to a Parallax Propeller micro-controller.")
|
||||
(license license:expat))))
|
||||
|
||||
(define-public spin2cpp
|
||||
(package
|
||||
(name "spin2cpp")
|
||||
(version "3.4.0")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "https://github.com/totalspectrum/spin2cpp/"
|
||||
"archive/v" version ".tar.gz"))
|
||||
(file-name (string-append name "-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"00i8i0dspd5115ggkv5vx2xqb21l6y38wz0bakgby8n3b4k9xnk0"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
`(#:tests? #f ;; The tests assume that a micro-controller is connected.
|
||||
#:phases
|
||||
(modify-phases %standard-phases
|
||||
(delete 'configure)
|
||||
(add-before 'build 'set-cross-environment-variables
|
||||
(lambda* (#:key inputs #:allow-other-keys)
|
||||
(setenv "CROSS_LIBRARY_PATH"
|
||||
(string-append (assoc-ref inputs "propeller-toolchain")
|
||||
"/propeller-elf/lib"))
|
||||
(setenv "CROSS_C_INCLUDE_PATH"
|
||||
(string-append (assoc-ref inputs "propeller-toolchain")
|
||||
"/propeller-elf/include"))
|
||||
#t))
|
||||
(replace 'install
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(let ((bin (string-append (assoc-ref outputs "out")
|
||||
"/bin")))
|
||||
(for-each (lambda (file)
|
||||
(install-file (string-append "build/" file)
|
||||
bin))
|
||||
'("testlex" "spin2cpp" "fastspin")))
|
||||
#t)))))
|
||||
(native-inputs
|
||||
`(("bison" ,bison)
|
||||
("propeller-load" ,propeller-load)
|
||||
("propeller-toolchain" ,propeller-toolchain)))
|
||||
(home-page "https://github.com/totalspectrum/spin2cpp")
|
||||
(synopsis "Convert Spin code to C, C++, or PASM code")
|
||||
(description "This is a set of tools for converting the Spin language for
|
||||
the Parallax Propeller micro-controller into C or C++ code, into PASM, or even
|
||||
directly into an executable binary. The binaries produced use LMM PASM, so
|
||||
they are much faster than regular Spin bytecodes (but also quite a bit
|
||||
larger).")
|
||||
(license license:expat)))
|
||||
|
||||
(define-public spinsim
|
||||
(let ((commit "66915a7ad1a3a2cf990a725bb341fab8d11eb620")
|
||||
(revision "1"))
|
||||
(package
|
||||
(name "spinsim")
|
||||
(version (string-append "0.75-" revision "." (string-take commit 9)))
|
||||
(source (origin
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
(url "https://github.com/parallaxinc/spinsim.git")
|
||||
(commit commit)))
|
||||
(file-name (string-append name "-" commit "-checkout"))
|
||||
(sha256
|
||||
(base32
|
||||
"1n9kdhlxsdx7bz6c80w8dhi96zp633gd6qs0x9i4ii8qv4i7sj5k"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
`(#:tests? #f ; no tests
|
||||
#:phases
|
||||
(modify-phases %standard-phases
|
||||
(delete 'configure)
|
||||
(replace 'install
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(let ((bin (string-append (assoc-ref outputs "out")
|
||||
"/bin")))
|
||||
(install-file "build/spinsim" bin))
|
||||
#t)))))
|
||||
(home-page "https://github.com/parallaxinc/spinsim")
|
||||
(synopsis "Spin simulator")
|
||||
(description "This package provides the tool @code{spinsim}, a simulator
|
||||
and simple debugger for Spin programs written for a Parallax Propeller
|
||||
micro-controller. Spinsim supports execution from cog memory and hub
|
||||
execution, but it does not support multi-tasking. It supports about
|
||||
two-thirds of the opcodes in the P2 instruction set.")
|
||||
(license license:expat))))
|
||||
|
||||
(define-public propeller-development-suite
|
||||
(package
|
||||
(name "propeller-development-suite")
|
||||
(version (package-version propeller-gcc))
|
||||
(source #f)
|
||||
(build-system trivial-build-system)
|
||||
(arguments '(#:builder (mkdir %output)))
|
||||
(propagated-inputs
|
||||
`(("toolchain" ,propeller-toolchain)
|
||||
("openspin" ,openspin)
|
||||
("propeller-load" ,propeller-load)
|
||||
("spin2cpp" ,spin2cpp)
|
||||
("spinsim" ,spinsim)))
|
||||
(synopsis "Complete development suite for Propeller micro-controllers")
|
||||
(description "This meta-package provides a complete environment for the
|
||||
development with Parallax Propeller micro-controllers. It includes the GCC
|
||||
toolchain, the loader, the Openspin compiler, the Spin2cpp tool, and the Spin
|
||||
simulator.")
|
||||
(home-page (package-home-page propeller-gcc))
|
||||
(license (package-license propeller-gcc))))
|
||||
|
||||
@@ -3,7 +3,7 @@
|
||||
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
|
||||
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
|
||||
;;; Copyright © 2016 David Thompson <davet@gnu.org>
|
||||
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2016 Theodoros Foradis <theodoros.for@openmailbox.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
@@ -545,7 +545,7 @@ as well as pick-place files.")
|
||||
(getenv "CPLUS_INCLUDE_PATH")))
|
||||
#t)))
|
||||
(add-after 'install 'install-guile-bindings
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(lambda* (#:key inputs outputs #:allow-other-keys)
|
||||
;; Install the Guile bindings (the build system only installs
|
||||
;; libao.so.)
|
||||
(let* ((out (assoc-ref outputs "out"))
|
||||
@@ -574,6 +574,14 @@ as well as pick-place files.")
|
||||
|
||||
(install-file "bin/ao-guile"
|
||||
(string-append out "/bin"))
|
||||
|
||||
;; Allow Ao to dlopen the relevant GL libraries. Otherwise
|
||||
;; it fails with:
|
||||
;; Couldn't find current GLX or EGL context.
|
||||
(let ((mesa (assoc-ref inputs "mesa")))
|
||||
(wrap-program (string-append out "/bin/ao-guile")
|
||||
`("LD_LIBRARY_PATH" ":" prefix
|
||||
(,(string-append mesa "/lib")))))
|
||||
#t)))))))
|
||||
(native-inputs
|
||||
`(("pkg-config" ,pkg-config)))
|
||||
@@ -583,6 +591,7 @@ as well as pick-place files.")
|
||||
("libpng" ,libpng)
|
||||
("glfw" ,glfw)
|
||||
("libepoxy" ,libepoxy)
|
||||
("mesa" ,mesa)
|
||||
("eigen" ,eigen)
|
||||
("glm" ,glm)
|
||||
("guile" ,guile-2.0)))
|
||||
|
||||
+88
-71
@@ -7,13 +7,14 @@
|
||||
;;; Copyright © 2015 Eric Dvorsak <eric@dvorsak.fr>
|
||||
;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net>
|
||||
;;; Copyright © 2015, 2016 Leo Famulari <leo@famulari.name>
|
||||
;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is>
|
||||
;;; Copyright © 2016, 2017 ng0 <ng0@libertad.pw>
|
||||
;;; Copyright © 2016 Jookia <166291@gmail.com>
|
||||
;;; Copyright © 2016 Eric Bavier <bavier@member.fsf.org>
|
||||
;;; Copyright © 2016 Dmitry Nikolaev <cameltheman@gmail.com>
|
||||
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
|
||||
;;; Copyright © 2016 Marius Bakke <mbakke@fastmail.com>
|
||||
;;; Copyright © 2016 Toni Reina <areina@riseup.net>
|
||||
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -108,12 +109,10 @@ in print. With attention to detail for high resolution rendering.")
|
||||
(mkdir-p doc-dir)
|
||||
(chdir (string-append "ubuntu-font-family-" ,version))
|
||||
(for-each (lambda (ttf)
|
||||
(copy-file ttf
|
||||
(string-append font-dir "/" ttf)))
|
||||
(install-file ttf font-dir))
|
||||
(find-files "." "\\.ttf$"))
|
||||
(for-each (lambda (doc)
|
||||
(copy-file doc
|
||||
(string-append doc-dir "/" doc)))
|
||||
(install-file doc doc-dir))
|
||||
(find-files "." "\\.txt$"))))))
|
||||
(native-inputs `(("source" ,source)
|
||||
("unzip" ,unzip)))
|
||||
@@ -165,19 +164,13 @@ TrueType (TTF) files.")
|
||||
(mkdir-p doc-dir)
|
||||
(chdir (string-append "dejavu-fonts-ttf-" ,version))
|
||||
(for-each (lambda (ttf)
|
||||
(copy-file ttf
|
||||
(string-append font-dir "/"
|
||||
(basename ttf))))
|
||||
(install-file ttf font-dir))
|
||||
(find-files "ttf" "\\.ttf$"))
|
||||
(for-each (lambda (conf)
|
||||
(copy-file conf
|
||||
(string-append conf-dir "/"
|
||||
(basename conf))))
|
||||
(install-file conf conf-dir))
|
||||
(find-files "fontconfig" "\\.conf$"))
|
||||
(for-each (lambda (doc)
|
||||
(copy-file doc
|
||||
(string-append doc-dir "/"
|
||||
(basename doc))))
|
||||
(install-file doc doc-dir))
|
||||
(find-files "." "\\.txt$|^[A-Z][A-Z]*$"))))))
|
||||
(native-inputs `(("source" ,source)
|
||||
("tar" ,tar)
|
||||
@@ -186,7 +179,7 @@ TrueType (TTF) files.")
|
||||
(synopsis "Vera font family derivate with additional characters")
|
||||
(description "DejaVu provides an expanded version of the Vera font family
|
||||
aiming for quality and broader Unicode coverage while retaining the original
|
||||
Vera style. DejaVu currently works towards conformance with the Multilingual
|
||||
Vera style. DejaVu currently works towards conformance to the Multilingual
|
||||
European Standards (MES-1 and MES-2) for Unicode coverage. The DejaVu fonts
|
||||
provide serif, sans and monospaced variants.")
|
||||
(license
|
||||
@@ -229,12 +222,10 @@ provide serif, sans and monospaced variants.")
|
||||
(mkdir-p doc-dir)
|
||||
(chdir (string-append "ttf-bitstream-vera-" ,version))
|
||||
(for-each (lambda (ttf)
|
||||
(copy-file ttf
|
||||
(string-append font-dir "/" ttf)))
|
||||
(install-file ttf font-dir))
|
||||
(find-files "." "\\.ttf$"))
|
||||
(for-each (lambda (doc)
|
||||
(copy-file doc
|
||||
(string-append doc-dir "/" doc)))
|
||||
(install-file doc doc-dir))
|
||||
(find-files "." "\\.TXT$"))))))
|
||||
(native-inputs `(("source" ,source)
|
||||
("tar" ,tar)
|
||||
@@ -294,9 +285,7 @@ sans-serif designed for on-screen reading. It is used by GNOME@tie{}3.")
|
||||
(system* "make" "ttftar")
|
||||
(mkdir-p font-dir)
|
||||
(for-each (lambda (file)
|
||||
(copy-file file
|
||||
(string-append font-dir "/"
|
||||
(basename file))))
|
||||
(install-file file font-dir))
|
||||
(filter
|
||||
(lambda (file) (string-suffix? "ttf" file))
|
||||
(find-files "." "")))))))
|
||||
@@ -348,14 +337,10 @@ sans-serif designed for on-screen reading. It is used by GNOME@tie{}3.")
|
||||
(mkdir-p doc-dir)
|
||||
(chdir (string-append "liberation-fonts-ttf-" ,version))
|
||||
(for-each (lambda (ttf)
|
||||
(copy-file ttf
|
||||
(string-append font-dir "/"
|
||||
(basename ttf))))
|
||||
(install-file ttf font-dir))
|
||||
(find-files "." "\\.ttf$"))
|
||||
(for-each (lambda (doc)
|
||||
(copy-file doc
|
||||
(string-append doc-dir "/"
|
||||
(basename doc))))
|
||||
(install-file doc doc-dir))
|
||||
'("AUTHORS" "ChangeLog" "LICENSE" "README" "TODO"))))))
|
||||
(native-inputs
|
||||
`(("source" ,source)
|
||||
@@ -367,17 +352,16 @@ sans-serif designed for on-screen reading. It is used by GNOME@tie{}3.")
|
||||
(description
|
||||
"The Liberation font family aims at metric compatibility with
|
||||
Arial, Times New Roman, and Courier New.
|
||||
|
||||
There are three sets:
|
||||
|
||||
- Sans (a substitute for Arial, Albany, Helvetica, Nimbus Sans L, and
|
||||
@enumerate
|
||||
@item Sans (a substitute for Arial, Albany, Helvetica, Nimbus Sans L, and
|
||||
Bitstream Vera Sans);
|
||||
|
||||
- Serif (a substitute for Times New Roman, Thorndale, Nimbus Roman, and
|
||||
@item Serif (a substitute for Times New Roman, Thorndale, Nimbus Roman, and
|
||||
Bitstream Vera Serif);
|
||||
|
||||
- Mono (a substitute for Courier New, Cumberland, Courier, Nimbus Mono L,
|
||||
@item Mono (a substitute for Courier New, Cumberland, Courier, Nimbus Mono L,
|
||||
and Bitstream Vera Sans Mono).
|
||||
@end enumerate
|
||||
|
||||
The Liberation Fonts are sponsored by Red Hat.")
|
||||
(license license:silofl1.1)))
|
||||
@@ -414,8 +398,8 @@ The Liberation Fonts are sponsored by Red Hat.")
|
||||
#:tests? #f)) ;; No test target in tarball
|
||||
(home-page "http://terminus-font.sourceforge.net/")
|
||||
(synopsis "Simple bitmap programming font")
|
||||
(description "Terminus Font is a clean, fixed width bitmap font, designed
|
||||
for long (8 and more hours per day) work with computers.")
|
||||
(description "Terminus Font is a clean, fixed-width bitmap font, designed
|
||||
for long periods of working with computers (8 or more hours per day).")
|
||||
(license license:silofl1.1)))
|
||||
|
||||
(define-public font-adobe-source-han-sans
|
||||
@@ -501,8 +485,7 @@ text in Simplified Chinese, Traditional Chinese, Japanese, and Korean.")
|
||||
(mkdir-p font-dir)
|
||||
(system* "tar" "xvf" (assoc-ref %build-inputs "source"))
|
||||
(chdir "wqy-zenhei")
|
||||
(copy-file "wqy-zenhei.ttc"
|
||||
(string-append font-dir "wqy-zenhei.ttc"))))))
|
||||
(install-file "wqy-zenhei.ttc" font-dir)))))
|
||||
(native-inputs
|
||||
`(("gzip" ,gzip)
|
||||
("tar" ,tar)))
|
||||
@@ -512,12 +495,12 @@ text in Simplified Chinese, Traditional Chinese, Japanese, and Korean.")
|
||||
"WenQuanYi Zen Hei is a Hei-Ti style (sans-serif type) Chinese outline
|
||||
font. It is designed for general purpose text formatting and on-screen
|
||||
display of Chinese characters and symbols from many other languages.
|
||||
WenQuanYi Zen Hei provides a rather complete coverage to Chinese Hanzi glyphs,
|
||||
WenQuanYi Zen Hei provides a rather complete coverage of Chinese Hanzi glyphs,
|
||||
including both simplified and traditional forms. The total glyph number in
|
||||
this font is over 35,000, including over 21,000 Chinese Hanzi. This font has
|
||||
full coverage to GBK(CP936) charset, CJK Unified Ideographs, as well as the
|
||||
code-points needed for zh_cn, zh_sg, zh_tw, zh_hk, zh_mo, ja (Japanese) and
|
||||
ko (Korean) locales for fontconfig.")
|
||||
full coverage of the GBK (CP936) charset, CJK Unified Ideographs, as well as
|
||||
the code-points needed for zh_cn, zh_sg, zh_tw, zh_hk, zh_mo, ja (Japanese) and
|
||||
ko (Korean) locales for @code{fontconfig}.")
|
||||
;; GPLv2 with font embedding exception
|
||||
(license license:gpl2)))
|
||||
|
||||
@@ -585,12 +568,10 @@ Heros, Pagella, Schola, Termes.")
|
||||
(mkdir-p doc-dir)
|
||||
(chdir (string-append "AnonymousPro-" ,version ".001"))
|
||||
(for-each (lambda (ttf)
|
||||
(copy-file ttf
|
||||
(string-append font-dir "/" ttf)))
|
||||
(install-file ttf font-dir))
|
||||
(find-files "." "\\.ttf$"))
|
||||
(for-each (lambda (doc)
|
||||
(copy-file doc
|
||||
(string-append doc-dir "/" doc)))
|
||||
(install-file doc doc-dir))
|
||||
(find-files "." "\\.txt$"))))))
|
||||
(native-inputs
|
||||
`(("unzip" ,unzip)))
|
||||
@@ -605,7 +586,7 @@ languages, plus Greek and Cyrillic.")
|
||||
(define-public font-gnu-unifont
|
||||
(package
|
||||
(name "font-gnu-unifont")
|
||||
(version "9.0.02")
|
||||
(version "9.0.06")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
@@ -613,7 +594,7 @@ languages, plus Greek and Cyrillic.")
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1ss6cp2bs8mzz3jqjbmmi877jfdb1jjcd29dvyk3i8qy7r0d44qm"))))
|
||||
"0ybyraxi8pngibazfq4zlsqmg8kn5xlhvaiwnxb11znhfi61vi87"))))
|
||||
(build-system gnu-build-system)
|
||||
(outputs '("out" ; TrueType version
|
||||
"pcf" ; PCF (bitmap) version
|
||||
@@ -625,9 +606,9 @@ languages, plus Greek and Cyrillic.")
|
||||
#:tests? #f ; no check target
|
||||
#:phases
|
||||
(modify-phases %standard-phases
|
||||
(replace 'configure
|
||||
(lambda _
|
||||
(setenv "CC" "gcc")))
|
||||
(replace
|
||||
'configure
|
||||
(lambda _ (setenv "CC" "gcc") #t))
|
||||
(replace
|
||||
'install
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
@@ -688,21 +669,62 @@ utilities to ease adding new glyphs to the font.")
|
||||
|
||||
(mkdir-p font-dir)
|
||||
(for-each (lambda (ttf)
|
||||
(copy-file ttf
|
||||
(string-append font-dir "/" ttf)))
|
||||
(install-file ttf font-dir))
|
||||
(find-files "." "\\.ttf$"))
|
||||
(for-each (lambda (otf)
|
||||
(copy-file otf
|
||||
(string-append font-dir "/" otf)))
|
||||
(install-file otf font-dir))
|
||||
(find-files "." "\\.otf$"))))))
|
||||
(native-inputs `(("unzip" ,unzip)))
|
||||
(home-page "https://www.google.com/get/noto/")
|
||||
(synopsis "Fonts aimed to cover all languages")
|
||||
(description "Googe Noto Fonts is a family of fonts aimed to support all
|
||||
languages with a consistent look and aesthetic. It's goal is to have no Unicode
|
||||
symbols unable to be displayed properly.")
|
||||
(synopsis "Fonts to cover all languages")
|
||||
(description "Google Noto Fonts is a family of fonts designed to support
|
||||
all languages with a consistent look and aesthetic. Its goal is to properly
|
||||
display all Unicode symbols.")
|
||||
(license license:silofl1.1)))
|
||||
|
||||
(define-public font-google-roboto
|
||||
(package
|
||||
(name "font-google-roboto")
|
||||
(version "2.136")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "https://github.com/google/roboto/releases/download/"
|
||||
"v" version "/roboto-hinted.zip"))
|
||||
(file-name (string-append name "-" version ".zip"))
|
||||
(sha256
|
||||
(base32
|
||||
"0spscx08fad7i8qs7icns96iwcapniq8lwwqqvbf7bamvs8qfln4"))))
|
||||
(native-inputs `(("unzip" ,unzip)))
|
||||
(build-system trivial-build-system)
|
||||
(arguments
|
||||
`(#:modules ((guix build utils))
|
||||
#:builder (begin
|
||||
(use-modules (guix build utils)
|
||||
(srfi srfi-26))
|
||||
|
||||
(let ((PATH (string-append (assoc-ref %build-inputs
|
||||
"unzip")
|
||||
"/bin"))
|
||||
(font-dir (string-append %output
|
||||
"/share/fonts/truetype")))
|
||||
(setenv "PATH" PATH)
|
||||
(system* "unzip" (assoc-ref %build-inputs "source"))
|
||||
|
||||
(mkdir-p font-dir)
|
||||
(chdir "roboto-hinted")
|
||||
(for-each (lambda (ttf)
|
||||
(copy-file ttf
|
||||
(string-append font-dir "/" ttf)))
|
||||
(find-files "." "\\.ttf$"))))))
|
||||
(home-page "https://github.com/google/roboto")
|
||||
(synopsis "The Roboto family of fonts")
|
||||
(description
|
||||
"Roboto is Google’s signature family of fonts, the default font on Android
|
||||
and Chrome OS, and the recommended font for the
|
||||
visual language \"Material Design\".")
|
||||
(license license:asl2.0)))
|
||||
|
||||
(define-public font-un
|
||||
(package
|
||||
(name "font-un")
|
||||
@@ -735,14 +757,10 @@ symbols unable to be displayed properly.")
|
||||
(mkdir-p doc-dir)
|
||||
(chdir (string-append "un-fonts"))
|
||||
(for-each (lambda (ttf)
|
||||
(copy-file ttf
|
||||
(string-append font-dir "/"
|
||||
(basename ttf))))
|
||||
(install-file ttf font-dir))
|
||||
(find-files "." "\\.ttf$"))
|
||||
(for-each (lambda (doc)
|
||||
(copy-file doc
|
||||
(string-append doc-dir "/"
|
||||
(basename doc))))
|
||||
(install-file doc doc-dir))
|
||||
'("COPYING" "README"))))))
|
||||
(native-inputs
|
||||
`(("tar" ,tar)
|
||||
@@ -840,18 +858,17 @@ glyph designs, not just an added slant.")
|
||||
|
||||
(mkdir-p font-dir)
|
||||
(for-each (lambda (ttf)
|
||||
(copy-file ttf
|
||||
(string-append font-dir "/" ttf)))
|
||||
(install-file ttf font-dir))
|
||||
(find-files "." "\\.ttf$"))))))
|
||||
(native-inputs
|
||||
`(("source" ,source)
|
||||
("unzip" ,unzip)))
|
||||
(home-page "https://sourcefoundry.org/hack/")
|
||||
(synopsis "Typeface designed for sourcecode")
|
||||
(synopsis "Typeface designed for source code")
|
||||
(description
|
||||
"Hack is designed to be a workhorse typeface for code, it expands upon
|
||||
the Bitstream Vera & DejaVu projects, provides 1561 glyphs including
|
||||
powerline support.")
|
||||
"Hack is designed to be a workhorse typeface for code. It expands upon
|
||||
the Bitstream Vera & DejaVu projects, provides 1561 glyphs, and includes
|
||||
Powerline support.")
|
||||
(license (license:x11-style
|
||||
"https://github.com/chrissimpkins/Hack/blob/master/LICENSE.md"
|
||||
"Hack Open Font License v2.0"))))
|
||||
|
||||
+15
-3
@@ -1,5 +1,6 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2016 Danny Milosavljevic <dannym@scratchpost.org>
|
||||
;;; Copyright © 2016 Theodoros Foradis <theodoros.for@openmailbox.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -31,7 +32,9 @@
|
||||
#:use-module (gnu packages bison)
|
||||
#:use-module (gnu packages flex)
|
||||
#:use-module (gnu packages gtk)
|
||||
#:use-module (gnu packages graphviz)
|
||||
#:use-module (gnu packages libffi)
|
||||
#:use-module (gnu packages linux)
|
||||
#:use-module (gnu packages zip)
|
||||
#:use-module (gnu packages perl)
|
||||
#:use-module (gnu packages ghostscript)
|
||||
@@ -114,7 +117,7 @@ For synthesis, the compiler generates netlists in the desired format.")
|
||||
(define-public yosys
|
||||
(package
|
||||
(name "yosys")
|
||||
(version "0.6")
|
||||
(version "0.7")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri
|
||||
@@ -122,7 +125,7 @@ For synthesis, the compiler generates netlists in the desired format.")
|
||||
name "-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"02j0c0m9dfyjccynalf0aggj6gy20k7iphpkg5cn6sdirlkv8gmx"))
|
||||
"0vkfdn4phvkjqlnpqlr6q5f97bgjc3312vj5jf0vf85zqv88dy9x"))
|
||||
(file-name (string-append name "-" version "-checkout.tar.gz"))
|
||||
(modules '((guix build utils)))
|
||||
(snippet
|
||||
@@ -136,6 +139,13 @@ For synthesis, the compiler generates netlists in the desired format.")
|
||||
(string-append "PREFIX=" %output))
|
||||
#:phases
|
||||
(modify-phases %standard-phases
|
||||
(add-before 'configure 'fix-paths
|
||||
(lambda _
|
||||
(substitute* "./passes/cmds/show.cc"
|
||||
(("exec xdot") (string-append "exec " (which "xdot")))
|
||||
(("dot -") (string-append (which "dot") " -"))
|
||||
(("fuser") (which "fuser")))
|
||||
#t))
|
||||
(replace 'configure
|
||||
(lambda* (#:key inputs (make-flags '()) #:allow-other-keys)
|
||||
(zero? (apply system* "make" "config-gcc" make-flags))))
|
||||
@@ -172,7 +182,6 @@ For synthesis, the compiler generates netlists in the desired format.")
|
||||
(("iverilog_bin=\".*\"") (string-append "iverilog_bin=\""
|
||||
iverilog "\"")))
|
||||
#t))))))
|
||||
;; TODO add xdot [patch the path to it here] as soon as I find out where it is.
|
||||
(native-inputs
|
||||
`(("pkg-config" ,pkg-config)
|
||||
("python" ,python)
|
||||
@@ -185,6 +194,9 @@ For synthesis, the compiler generates netlists in the desired format.")
|
||||
`(("tcl" ,tcl)
|
||||
("readline" ,readline)
|
||||
("libffi" ,libffi)
|
||||
("graphviz" ,graphviz)
|
||||
("psmisc" ,psmisc)
|
||||
("xdot" ,xdot)
|
||||
("abc" ,abc)))
|
||||
(home-page "http://www.clifford.at/yosys/")
|
||||
(synopsis "FPGA Verilog RTL synthesizer")
|
||||
|
||||
@@ -2,7 +2,7 @@
|
||||
;;; Copyright © 2015 Andreas Enge <andreas@enge.fr>
|
||||
;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
|
||||
;;; Copyright © 2015 Andy Wingo <wingo@pobox.com>
|
||||
;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net>
|
||||
;;; Copyright © 2015 David Hashe <david.hashe@dhashe.com>
|
||||
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
|
||||
@@ -42,11 +42,13 @@
|
||||
#:use-module (gnu packages gl)
|
||||
#:use-module (gnu packages glib) ;intltool
|
||||
#:use-module (gnu packages gnome)
|
||||
#:use-module (gnu packages gnuzilla)
|
||||
#:use-module (gnu packages gperf)
|
||||
#:use-module (gnu packages graphviz)
|
||||
#:use-module (gnu packages gtk)
|
||||
#:use-module (gnu packages libffi)
|
||||
#:use-module (gnu packages libunwind)
|
||||
#:use-module (gnu packages libusb)
|
||||
#:use-module (gnu packages linux)
|
||||
#:use-module (gnu packages m4)
|
||||
#:use-module (gnu packages polkit)
|
||||
@@ -85,14 +87,14 @@ freedesktop.org project.")
|
||||
(define-public libinput
|
||||
(package
|
||||
(name "libinput")
|
||||
(version "1.5.1")
|
||||
(version "1.5.3")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "https://freedesktop.org/software/libinput/"
|
||||
name "-" version ".tar.xz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1n1dispg63z1qiy8c1af3l9c4a9dks8y7xasff8xcywnn0rkkxnl"))))
|
||||
"1qx623nyr49sxv49ilb0j85skgk1dhkr82vd577ywyjf7d96q84i"))))
|
||||
(build-system gnu-build-system)
|
||||
(native-inputs
|
||||
`(("cairo" ,cairo)
|
||||
@@ -211,7 +213,8 @@ the freedesktop.org XDG Base Directory specification.")
|
||||
("shepherd" ,shepherd) ;for 'halt' and 'reboot', invoked
|
||||
;when pressing the power button
|
||||
("dbus" ,dbus)
|
||||
("eudev" ,eudev)))
|
||||
("eudev" ,eudev)
|
||||
("acl" ,acl))) ;to add individual users to ACLs on /dev nodes
|
||||
(home-page "https://github.com/wingo/elogind")
|
||||
(synopsis "User, seat, and session management service")
|
||||
(description "Elogind is the systemd project's \"logind\" service,
|
||||
@@ -804,3 +807,65 @@ share connections to real-time communication services without conflicting.")
|
||||
useful for both applications which need colour management and applications that
|
||||
wish to perform colour calibration.")
|
||||
(license license:lgpl2.1+)))
|
||||
|
||||
(define-public libfprint
|
||||
(package
|
||||
(name "libfprint")
|
||||
(version "0.6.0")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "https://people.freedesktop.org/~hadess/"
|
||||
name "-" version ".tar.xz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1giwh2z63mn45galsjb59rhyrvgwcy01hvvp4g01iaa2snvzr0r5"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
'(#:configure-flags (list (string-append "--with-udev-rules-dir="
|
||||
(assoc-ref %outputs "out")
|
||||
"/lib/udev/rules.d"))))
|
||||
(native-inputs
|
||||
`(("pkg-config" ,pkg-config)))
|
||||
(inputs
|
||||
`(("libusb" ,libusb)
|
||||
("nss" ,nss)
|
||||
("glib" ,glib)
|
||||
("eudev" ,eudev)
|
||||
("pixman" ,pixman)))
|
||||
(home-page "https://www.freedesktop.org/wiki/Software/fprint/libfprint/")
|
||||
(synopsis "Library to access fingerprint readers")
|
||||
(description
|
||||
"libfprint is a library designed to make it easy for application
|
||||
developers to add support for consumer fingerprint readers to their
|
||||
software.")
|
||||
(license license:lgpl2.1+)))
|
||||
|
||||
(define-public fprintd
|
||||
(package
|
||||
(name "fprintd")
|
||||
(version "0.7.0")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
"https://people.freedesktop.org/~hadess/fprintd-"
|
||||
version ".tar.xz"))
|
||||
(sha256
|
||||
(base32
|
||||
"05915i0bv7q62fqrs5diqwr8dz3pwqa1c1ivcgggkjyw0xk4ldp5"))))
|
||||
(build-system gnu-build-system)
|
||||
(native-inputs
|
||||
`(("pkg-config" ,pkg-config)
|
||||
("intltool" ,intltool)))
|
||||
(inputs
|
||||
`(("libfprint" ,libfprint)
|
||||
("dbus-glib" ,dbus-glib)
|
||||
("polkit" ,polkit)
|
||||
("linux-pam" ,linux-pam))) ;for pam_fprintd
|
||||
(home-page "https://www.freedesktop.org/wiki/Software/fprint/fprintd/")
|
||||
(synopsis "D-Bus daemon that exposes fingerprint reader functionality")
|
||||
(description
|
||||
"fprintd is a D-Bus daemon that offers functionality of libfprint, a
|
||||
library to access fingerprint readers, over the D-Bus interprocess
|
||||
communication bus. This daemon layer above libfprint solves problems related
|
||||
to applications simultaneously competing for fingerprint readers.")
|
||||
(license license:gpl2+)))
|
||||
|
||||
@@ -140,7 +140,7 @@ provide connectivity for client applications written in any language.")
|
||||
(define-public tiled
|
||||
(package
|
||||
(name "tiled")
|
||||
(version "0.17.0")
|
||||
(version "0.18.0")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "https://github.com/bjorn/tiled/archive/v"
|
||||
@@ -148,7 +148,7 @@ provide connectivity for client applications written in any language.")
|
||||
(file-name (string-append name "-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0c9gykxmq0sk0yyfdq81g9psd922scqzn5asskjydj84d80f5z7p"))))
|
||||
"0csrwf7k3fxv6bv580w6wxjk1q2j9mj9k0xba3nb1ms6jiz1bvzk"))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs `(("qt" ,qt)
|
||||
("zlib" ,zlib)))
|
||||
|
||||
@@ -649,7 +649,7 @@ match, cannon keep, and grave-itation pit.")
|
||||
(define minetest-data
|
||||
(package
|
||||
(name "minetest-data")
|
||||
(version "0.4.14")
|
||||
(version "0.4.15")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
@@ -658,7 +658,7 @@ match, cannon keep, and grave-itation pit.")
|
||||
(file-name (string-append name "-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"11fzdh4icx2yvjfz1skdql0d0wxpzdr006k993v33x72s0q2ig7f"))))
|
||||
"12kxklcd1b5n0f369zf3xxhvkrizxj4d9xv0dh8crfqiymaym0zm"))))
|
||||
(build-system trivial-build-system)
|
||||
(native-inputs
|
||||
`(("source" ,source)
|
||||
@@ -690,7 +690,7 @@ match, cannon keep, and grave-itation pit.")
|
||||
(define-public minetest
|
||||
(package
|
||||
(name "minetest")
|
||||
(version "0.4.14")
|
||||
(version "0.4.15")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
@@ -699,7 +699,7 @@ match, cannon keep, and grave-itation pit.")
|
||||
(file-name (string-append name "-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0m3hhk5icx4y4gd970z7ya2013fq4vvqbjljmck62ik03baf8g90"))))
|
||||
"1ag3jcj7kpq3ph12zirk1c0mj9i0g50wmw932f8gi11liq8yd12n"))))
|
||||
(build-system cmake-build-system)
|
||||
(arguments
|
||||
'(#:configure-flags
|
||||
@@ -968,7 +968,7 @@ Collect herrings and other goodies while sliding down the hill, but avoid fish
|
||||
bones.
|
||||
|
||||
This game is based on the GPL version of the famous game TuxRacer.")
|
||||
(home-page "http://sourceforge.net/projects/extremetuxracer/")
|
||||
(home-page "https://sourceforge.net/projects/extremetuxracer/")
|
||||
(license license:gpl2+)))
|
||||
|
||||
(define-public supertuxkart
|
||||
@@ -1254,7 +1254,7 @@ is programmed in Haskell.")
|
||||
(define-public manaplus
|
||||
(package
|
||||
(name "manaplus")
|
||||
(version "1.6.8.14")
|
||||
(version "1.6.12.24")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
@@ -1262,7 +1262,7 @@ is programmed in Haskell.")
|
||||
version "/manaplus-" version ".tar.xz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1mah4w6ng0j76cjzbw8y9m2ds5f1w5ka9b1k3gzgvxh4yaphqnff"))))
|
||||
"1g64pid26vcv1ay002bzz6ymabwrmy3wmklywpcgpvrhynm6f2cq"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
'(#:configure-flags
|
||||
@@ -2753,7 +2753,7 @@ with the \"Stamp\" tool within Tux Paint.")
|
||||
(define-public supertux
|
||||
(package
|
||||
(name "supertux")
|
||||
(version "0.5.0")
|
||||
(version "0.5.1")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "https://github.com/SuperTux/supertux/"
|
||||
@@ -2761,7 +2761,7 @@ with the \"Stamp\" tool within Tux Paint.")
|
||||
version "-Source.tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0fx7c7m6mfanqy7kln7yf6abb5l3r68picf32js2yls11jj0vbng"))))
|
||||
"1i8avad7w7ikj870z519j383ldy29r6f956bs38cbr8wk513pp69"))))
|
||||
(arguments
|
||||
'(#:tests? #f
|
||||
#:configure-flags '("-DINSTALL_SUBDIR_BIN=bin"
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
|
||||
;;; Copyright © 2014, 2015, 2016 Ricardo Wurmus <rekado@elephly.net>
|
||||
;;; Copyright © 2015 Andreas Enge <andreas@enge.fr>
|
||||
@@ -364,14 +364,14 @@ Go. It also includes runtime support libraries for these languages.")
|
||||
(define-public gcc-6
|
||||
(package
|
||||
(inherit gcc-5)
|
||||
(version "6.2.0")
|
||||
(version "6.3.0")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnu/gcc/gcc-"
|
||||
version "/gcc-" version ".tar.bz2"))
|
||||
(sha256
|
||||
(base32
|
||||
"1idpf43988v1a6i8lw9ak1r7igcfg1bm5kn011iydlr2qygmhi4r"))
|
||||
"17xjz30jb65hcf714vn9gcxvrrji8j20xm7n33qg1ywhyzryfsph"))
|
||||
(patches (search-patches "gcc-strmov-store-file-names.patch"
|
||||
"gcc-5.0-libvtv-runpath.patch"))))))
|
||||
|
||||
@@ -494,8 +494,11 @@ as the 'native-search-paths' field."
|
||||
%generic-search-paths))
|
||||
|
||||
(define-public gfortran
|
||||
(custom-gcc gcc "gfortran" '("fortran")
|
||||
%generic-search-paths))
|
||||
;; Note: Update this when GCC changes! We cannot use
|
||||
;; (custom-gcc gcc "fortran" …) because that would lead to a package object
|
||||
;; that is not 'eq?' with GFORTRAN-4.9, and thus 'fold-packages' would
|
||||
;; report two gfortran@4.9 that are in fact identical.
|
||||
gfortran-4.9)
|
||||
|
||||
(define-public gfortran-5
|
||||
(custom-gcc gcc-5 "gfortran" '("fortran")
|
||||
|
||||
@@ -293,7 +293,7 @@ architecture.")
|
||||
"Ghostscript fonts provides fonts and font metrics customarily distributed with
|
||||
Ghostscript. It currently includes the 35 standard PostScript fonts.")
|
||||
(license license:gpl2)
|
||||
(home-page "http://sourceforge.net/projects/gs-fonts/")))
|
||||
(home-page "https://sourceforge.net/projects/gs-fonts/")))
|
||||
|
||||
(define-public libspectre
|
||||
(package
|
||||
|
||||
@@ -35,6 +35,7 @@
|
||||
#:use-module (gnu packages ghostscript)
|
||||
#:use-module (gnu packages compression)
|
||||
#:use-module (gnu packages xml)
|
||||
#:use-module (gnu packages pdf)
|
||||
#:use-module (gnu packages photo)
|
||||
#:use-module (gnu packages python)
|
||||
#:use-module (gnu packages xorg)
|
||||
@@ -168,6 +169,7 @@ buffers.")
|
||||
("exif" ,libexif) ;optional, EXIF + XMP support
|
||||
("lcms" ,lcms) ;optional, color management
|
||||
("librsvg" ,librsvg) ;optional, SVG support
|
||||
("poppler", poppler) ; optional, PDF support
|
||||
("python" ,python-2) ;optional, Python support
|
||||
("python2-pygtk" ,python2-pygtk) ;optional, Python support
|
||||
("gegl" ,gegl)))
|
||||
|
||||
+17
-9
@@ -3866,7 +3866,7 @@ metadata in photo and video files of various formats.")
|
||||
(define-public shotwell
|
||||
(package
|
||||
(name "shotwell")
|
||||
(version "0.25.0.1")
|
||||
(version "0.25.2")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnome/sources/" name "/"
|
||||
@@ -3874,7 +3874,7 @@ metadata in photo and video files of various formats.")
|
||||
name "-" version ".tar.xz"))
|
||||
(sha256
|
||||
(base32
|
||||
"19h0ckrgv0c6sj85m6ankyqkmy453ph9kq6zhf7ys2k5xsrrd776"))))
|
||||
"1bih5hr3pvpkx3fck55bnhngn4fl92ryjizc34wb8pwigbkxnaj1"))))
|
||||
(build-system glib-or-gtk-build-system)
|
||||
(propagated-inputs
|
||||
`(("dconf" ,dconf)))
|
||||
@@ -5288,13 +5288,20 @@ existing databases over the internet.")
|
||||
(sha256
|
||||
(base32
|
||||
"1fj6wjvnjygzm9br3sw9gya6d18yly1rm69yaiar9spfbkvv4wai"))))
|
||||
(build-system gnu-build-system)
|
||||
(build-system glib-or-gtk-build-system)
|
||||
(arguments
|
||||
`(#:configure-flags '("--localstatedir=/tmp"
|
||||
"--sysconfdir=/tmp")
|
||||
#:imported-modules ((guix build python-build-system)
|
||||
,@%gnu-build-system-modules)
|
||||
,@%glib-or-gtk-build-system-modules)
|
||||
#:phases (modify-phases %standard-phases
|
||||
(add-after 'install 'wrap-program
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(let ((out (assoc-ref outputs "out"))
|
||||
(gi-typelib-path (getenv "GI_TYPELIB_PATH")))
|
||||
(wrap-program (string-append out "/bin/gnome-tweak-tool")
|
||||
`("GI_TYPELIB_PATH" ":" prefix (,gi-typelib-path))))
|
||||
#t))
|
||||
(add-after 'install 'wrap
|
||||
(@@ (guix build python-build-system) wrap)))))
|
||||
(native-inputs
|
||||
@@ -5302,9 +5309,10 @@ existing databases over the internet.")
|
||||
("pkg-config" ,pkg-config)))
|
||||
(inputs
|
||||
`(("python" ,python-2)
|
||||
("python2-pygobject" ,python2-pygobject)))
|
||||
(propagated-inputs
|
||||
`(("libnotify" ,libnotify)
|
||||
("python2-pygobject" ,python2-pygobject)
|
||||
("gnome-desktop" ,gnome-desktop)
|
||||
("libsoup" ,libsoup)
|
||||
("libnotify" ,libnotify)
|
||||
("gobject-introspection" ,gobject-introspection)
|
||||
("gsettings-desktop-schemas" ,gsettings-desktop-schemas)
|
||||
("gtk+" ,gtk+)))
|
||||
@@ -5347,7 +5355,7 @@ functionality and behavior.")
|
||||
(define-public arc-theme
|
||||
(package
|
||||
(name "arc-theme")
|
||||
(version "20160605")
|
||||
(version "20161119")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "https://github.com/horst3180/arc-theme"
|
||||
@@ -5355,7 +5363,7 @@ functionality and behavior.")
|
||||
(file-name (string-append name "-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0sq2031xda8jn2ws0x2bvhq77jfh7xy0c3kg86v6vm2kbrrss7y6"))))
|
||||
"1kbhaxmydyip3vdw4kf8rk776jcd9wf0w7z6h2i4naxdn4rsnw54"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
'(#:phases
|
||||
|
||||
@@ -122,8 +122,7 @@ financial calculations or scheduled transactions.")
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "http://www.aquamaniac.de/sites/download/download.php?"
|
||||
"package=01&release=201&file=01&dummy=gwenhywfar-"
|
||||
version ".tar.gz"))
|
||||
"package=01&release=201&file=01"))
|
||||
(file-name (string-append name "-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
@@ -157,13 +156,12 @@ applications and libraries. It is used by AqBanking.")
|
||||
(define-public aqbanking
|
||||
(package
|
||||
(name "aqbanking")
|
||||
(version "5.6.10")
|
||||
(version "5.6.12")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "http://www.aquamaniac.de/sites/download/download.php?"
|
||||
"package=03&release=206&file=01&dummy=aqbanking-"
|
||||
version ".tar.gz"))
|
||||
"package=03&release=208&file=01"))
|
||||
(file-name (string-append name "-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
|
||||
+30
-5
@@ -5,7 +5,7 @@
|
||||
;;; Copyright © 2015 Efraim Flashner <efraim@flashner.co.il>
|
||||
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
|
||||
;;; Copyright © 2016 Mark H Weaver <mhw@netris.org>
|
||||
;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is>
|
||||
;;; Copyright © 2016 ng0 <ng0@libertad.pw>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -162,7 +162,7 @@ and support for SSL3 and TLS.")
|
||||
(define-public gnurl
|
||||
(package
|
||||
(name "gnurl")
|
||||
(version "7.51.0")
|
||||
(version "7.52.1")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (let ((version-with-underscores
|
||||
@@ -171,13 +171,18 @@ and support for SSL3 and TLS.")
|
||||
name "-" version-with-underscores ".tar.bz2")))
|
||||
(sha256
|
||||
(base32
|
||||
"1rgl4agrzghvyfz1afk1p5ryq4b9cz28lavx8ikrav6aiv9h00ig"))))
|
||||
"1gn6mvab2vhfj9637ykg1zjzb23fngfnyd24wlgxmjhf49pn334h"))))
|
||||
(build-system gnu-build-system)
|
||||
(outputs '("out"
|
||||
"doc")) ; 1.5 MiB of man3 pages
|
||||
(inputs `(("gnutls" ,gnutls)
|
||||
("libidn" ,libidn)
|
||||
("zlib" ,zlib)))
|
||||
(native-inputs
|
||||
`(("groff" ,groff)
|
||||
`(("autoconf" ,autoconf)
|
||||
("automake" ,automake)
|
||||
("libtool" ,libtool)
|
||||
("groff" ,groff)
|
||||
("perl" ,perl)
|
||||
("pkg-config" ,pkg-config)
|
||||
("python" ,python-2)))
|
||||
@@ -198,10 +203,30 @@ and support for SSL3 and TLS.")
|
||||
#:phases
|
||||
;; We have to patch runtests.pl in tests/ directory
|
||||
(modify-phases %standard-phases
|
||||
(add-before 'check 'patch-runtests
|
||||
(add-after 'install 'move-man3-pages
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
;; Move section 3 man pages to "doc".
|
||||
(let ((out (assoc-ref outputs "out"))
|
||||
(doc (assoc-ref outputs "doc")))
|
||||
(mkdir-p (string-append doc "/share/man"))
|
||||
(rename-file (string-append out "/share/man/man3")
|
||||
(string-append doc "/share/man/man3"))
|
||||
#t)))
|
||||
(add-before 'configure 'autoconf
|
||||
;; Clear artifacts left (shebangs) from release preparation.
|
||||
(lambda _
|
||||
(zero? (system* "./buildconf"))))
|
||||
(replace 'check
|
||||
(lambda _
|
||||
;; It is unclear why test1026 fails, however the content of it
|
||||
;; suggests that it is not vital for gnurl.
|
||||
(delete-file "tests/data/test1026")
|
||||
|
||||
(substitute* "tests/runtests.pl"
|
||||
(("/bin/sh") (which "sh")))
|
||||
|
||||
;; Make test output more verbose.
|
||||
(zero? (system* "make" "-C" "tests" "test"))
|
||||
#t)))))
|
||||
(synopsis "Microfork of cURL with support for the HTTP/HTTPS/GnuTLS subset of cURL")
|
||||
(description
|
||||
|
||||
+90
-39
@@ -10,6 +10,8 @@
|
||||
;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is>
|
||||
;;; Copyright © 2016 Christopher Baines <mail@cbaines.net>
|
||||
;;; Copyright © 2016 Mike Gerwitz <mtg@gnu.org>
|
||||
;;; Copyright © 2016 Troy Sankey <sankeytms@gmail.com>
|
||||
;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -45,9 +47,11 @@
|
||||
#:use-module (gnu packages pkg-config)
|
||||
#:use-module (gnu packages ncurses)
|
||||
#:use-module (gnu packages security-token)
|
||||
#:use-module (gnu packages swig)
|
||||
#:use-module (gnu packages tls)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix git-download)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (guix build-system python))
|
||||
|
||||
@@ -213,20 +217,23 @@ compatible to GNU Pth.")
|
||||
(define-public gnupg
|
||||
(package
|
||||
(name "gnupg")
|
||||
(version "2.1.16")
|
||||
(version "2.1.17")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnupg/gnupg/gnupg-" version
|
||||
".tar.bz2"))
|
||||
(sha256
|
||||
(base32
|
||||
"0i483m9q032a0s50f1izb213g4h5i7pcgn395m6hvl3sg2kadfa9"))))
|
||||
"1js308b46ifx1gim0c9nivr5yxhans7iq1yvkf7zl2928gdm9p65"))
|
||||
(patches
|
||||
;; This fixes a test failure on 32bit. Remove for next version.
|
||||
;; https://lists.gnu.org/archive/html/guix-devel/2016-12/msg00869.html
|
||||
(search-patches "gnupg-test-segfault-on-32bit-arch.patch"))))
|
||||
(build-system gnu-build-system)
|
||||
(native-inputs
|
||||
`(("pkg-config" ,pkg-config)))
|
||||
(inputs
|
||||
`(("adns" ,adns)
|
||||
("bzip2" ,bzip2)
|
||||
`(("bzip2" ,bzip2)
|
||||
("curl" ,curl)
|
||||
("gnutls" ,gnutls)
|
||||
("libassuan" ,libassuan)
|
||||
@@ -347,7 +354,7 @@ libskba (working with X.509 certificates and CMS data).")
|
||||
(define-public gpgme
|
||||
(package
|
||||
(name "gpgme")
|
||||
(version "1.6.0")
|
||||
(version "1.8.0")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
@@ -355,7 +362,7 @@ libskba (working with X.509 certificates and CMS data).")
|
||||
".tar.bz2"))
|
||||
(sha256
|
||||
(base32
|
||||
"17892sclz3yg45wbyqqrzzpq3l0icbnfl28f101b3062g8cy97dh"))))
|
||||
"0csx3qnycwm0n90ql6gs65if5xi4gqyzzy21fxs2xqicghjrfq2r"))))
|
||||
(build-system gnu-build-system)
|
||||
(propagated-inputs
|
||||
;; Needs to be propagated because gpgme.h includes gpg-error.h.
|
||||
@@ -363,7 +370,15 @@ libskba (working with X.509 certificates and CMS data).")
|
||||
(inputs
|
||||
`(("gnupg" ,gnupg-2.0)
|
||||
("libassuan" ,libassuan)))
|
||||
(arguments '(#:make-flags '("GPG=gpg2")))
|
||||
(arguments
|
||||
`(#:phases
|
||||
(modify-phases %standard-phases
|
||||
(add-after 'configure 'patch-cmake-file
|
||||
(lambda _
|
||||
;; Work around <https://bugs.gnupg.org/gnupg/issue2877>.
|
||||
(substitute* "lang/cpp/src/GpgmeppConfig.cmake.in"
|
||||
(("@libsuffix@") ".so"))
|
||||
#t)))))
|
||||
(home-page "https://www.gnupg.org/related_software/gpgme/")
|
||||
(synopsis "Library providing simplified access to GnuPG functionality")
|
||||
(description
|
||||
@@ -378,6 +393,33 @@ instead. This way bug fixes or improvements can be done at a central place
|
||||
and every application benefits from this.")
|
||||
(license license:lgpl2.1+)))
|
||||
|
||||
(define-public python-gpg
|
||||
(package
|
||||
(name "python-gpg")
|
||||
(version (package-version gpgme))
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (pypi-uri "gpg" version))
|
||||
(sha256
|
||||
(base32
|
||||
"1x74i6q713c0bckls7rdm8kgsmllf9qvy9x62jghszlhgjkyh9nd"))))
|
||||
(build-system python-build-system)
|
||||
(arguments
|
||||
'(#:tests? #f)) ; No test suite.
|
||||
(inputs
|
||||
`(("gpgme" ,gpgme)))
|
||||
(native-inputs
|
||||
`(("swig" ,swig)))
|
||||
(home-page (package-home-page gpgme))
|
||||
(synopsis "Python bindings for GPGME GnuPG cryptography library")
|
||||
(description "This package provides Python bindings to the GPGME GnuPG
|
||||
cryptographic library. It is developed in the GPGME source code, and then
|
||||
distributed separately.")
|
||||
(license license:lgpl2.1+)))
|
||||
|
||||
(define-public python2-gpg
|
||||
(package-with-python2 python-gpg))
|
||||
|
||||
(define-public python-pygpgme
|
||||
(package
|
||||
(name "python-pygpgme")
|
||||
@@ -392,7 +434,8 @@ and every application benefits from this.")
|
||||
;; Unfortunately, we have to disable some tests due to some gpg-agent
|
||||
;; goofiness... see:
|
||||
;; https://bugs.launchpad.net/pygpgme/+bug/999949
|
||||
(patches (search-patches "pygpgme-disable-problematic-tests.patch"))))
|
||||
(patches (search-patches "pygpgme-disable-problematic-tests.patch"
|
||||
"python-pygpgme-fix-pinentry-tests.patch"))))
|
||||
(arguments
|
||||
`(#:phases
|
||||
(modify-phases %standard-phases
|
||||
@@ -457,35 +500,43 @@ and signature functionality from Python programs.")
|
||||
(package-with-python2 python-gnupg))
|
||||
|
||||
(define-public pius
|
||||
(package
|
||||
(name "pius")
|
||||
(version "2.2.2")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
"https://github.com/jaymzh/pius/releases/download/v"
|
||||
version "/pius-" version ".tar.bz2"))
|
||||
(sha256
|
||||
(base32
|
||||
"0k94mlr7l12mplph7pdgjbampqha47d8mfjq69n4xm80qwbn1rq1"))))
|
||||
(build-system python-build-system)
|
||||
(inputs `(("perl" ,perl) ;for 'pius-party-worksheet'
|
||||
("gpg" ,gnupg-2.0))) ;2.1 fails to talk to gpg-agent 2.0
|
||||
(arguments
|
||||
`(#:tests? #f
|
||||
#:python ,python-2 ;uses the Python 2 'print' syntax
|
||||
#:phases
|
||||
(modify-phases %standard-phases
|
||||
(add-before
|
||||
'build 'set-gpg-file-name
|
||||
(lambda* (#:key inputs outputs #:allow-other-keys)
|
||||
(let* ((gpg (string-append (assoc-ref inputs "gpg")
|
||||
"/bin/gpg")))
|
||||
(substitute* "libpius/constants.py"
|
||||
(("/usr/bin/gpg2") gpg))))))))
|
||||
(synopsis "Programs to simplify GnuPG key signing")
|
||||
(description
|
||||
"Pius (PGP Individual UID Signer) helps attendees of PGP keysigning
|
||||
;; pius 2.2.2 does not work with gpg-agent 2.1, so we take a newer
|
||||
;; commit. When a new pius (> 2.2.2) is released, update this package
|
||||
;; and delete this message.
|
||||
;; More info: https://github.com/jaymzh/pius/issues/46
|
||||
(let ((commit "891687ccb3d232a1fc0e7da7d22572c0318644cb")
|
||||
(base-version "2.2.2")) ; i.e. there were no releases
|
||||
; between BASE-VERSION and COMMIT
|
||||
(package
|
||||
(name "pius")
|
||||
(version (string-append base-version "-0."
|
||||
(string-take commit 7)))
|
||||
(source (origin
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
(url "https://github.com/jaymzh/pius.git")
|
||||
(commit commit)))
|
||||
(sha256
|
||||
(base32
|
||||
"0m2na4bnf1rv0zpf404l9ga6pwyf7ijldp4lw5irgh7gkmpllxr3"))))
|
||||
(build-system python-build-system)
|
||||
(inputs `(("perl" ,perl) ;for 'pius-party-worksheet'
|
||||
("gpg" ,gnupg)))
|
||||
(arguments
|
||||
`(#:tests? #f
|
||||
#:python ,python-2 ;uses the Python 2 'print' syntax
|
||||
#:phases
|
||||
(modify-phases %standard-phases
|
||||
(add-before
|
||||
'build 'set-gpg-file-name
|
||||
(lambda* (#:key inputs outputs #:allow-other-keys)
|
||||
(let* ((gpg (string-append (assoc-ref inputs "gpg")
|
||||
"/bin/gpg")))
|
||||
(substitute* "libpius/constants.py"
|
||||
(("/usr/bin/gpg2") gpg))))))))
|
||||
(synopsis "Programs to simplify GnuPG key signing")
|
||||
(description
|
||||
"Pius (PGP Individual UID Signer) helps attendees of PGP keysigning
|
||||
parties. It is the main utility and makes it possible to quickly and easily
|
||||
sign each UID on a set of PGP keys. It is designed to take the pain out of
|
||||
the sign-all-the-keys part of PGP Keysigning Party while adding security
|
||||
@@ -493,8 +544,8 @@ to the process.
|
||||
|
||||
pius-keyring-mgr and pius-party-worksheet help organisers of
|
||||
PGP keysigning parties.")
|
||||
(license license:gpl2)
|
||||
(home-page "https://www.phildev.net/pius/index.shtml")))
|
||||
(license license:gpl2)
|
||||
(home-page "https://www.phildev.net/pius/index.shtml"))))
|
||||
|
||||
(define-public signing-party
|
||||
(package
|
||||
|
||||
+45
-32
@@ -1,7 +1,7 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2013, 2015 Andreas Enge <andreas@enge.fr>
|
||||
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2014, 2015, 2016 Mark H Weaver <mhw@netris.org>
|
||||
;;; Copyright © 2014, 2015, 2016, 2017 Mark H Weaver <mhw@netris.org>
|
||||
;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
|
||||
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
|
||||
;;; Copyright © 2016 Alex Griffin <a@ajgrf.com>
|
||||
@@ -186,7 +186,11 @@ in the Mozilla clients.")
|
||||
(define-public nss
|
||||
(package
|
||||
(name "nss")
|
||||
(version "3.27.2")
|
||||
;; FIXME: NSS 3.27.2 fails its tests on armhf. At least some of the test
|
||||
;; failures appear to be caused by test certificates that have expired.
|
||||
;; Search the test suite output for 'PayPalEE.cert' for an example:
|
||||
;; <https://hydra.gnu.org/build/1712083>
|
||||
(version "3.27.1")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (let ((version-with-underscores
|
||||
@@ -197,7 +201,7 @@ in the Mozilla clients.")
|
||||
"nss-" version ".tar.gz")))
|
||||
(sha256
|
||||
(base32
|
||||
"0945q9yyhax9lkhxs1bjlr5gwknpvhzsa4zxfh127l398i9ci2nw"))
|
||||
"0sraxk26swlgl7rl742rkfp5k251v5z3lqw9k8ikin0cjfhkfdpx"))
|
||||
;; Create nss.pc and nss-config.
|
||||
(patches (search-patches "nss-pkgconfig.patch"))))
|
||||
(build-system gnu-build-system)
|
||||
@@ -317,35 +321,44 @@ standards.")
|
||||
(list
|
||||
(search-patch "icecat-avoid-bundled-libraries.patch")
|
||||
(search-patch "icecat-binutils.patch")
|
||||
(mozilla-patch "icecat-bug-1301381.patch" "2e5438a92617" "0pyjbzyy04759ldpcar8q8cccv67j1jkxsg46rkq7a3rbhmwmw4p") ;CVE-2016-9897
|
||||
(mozilla-patch "icecat-bug-1317409.patch" "7391f60fb790" "1hydggpmmm2cs9lb15micnkxn4wl4cda9g74hkn3zmks805vjz3h") ;CVE-2016-9899
|
||||
(mozilla-patch "icecat-bug-1309834.patch" "744e01001e6e" "0z2fq765kap3ll9as5rvjpnbj3pw26074alw7df0zi215qz47nxr") ;CVE-2016-9893-pt1
|
||||
(mozilla-patch "icecat-bug-1317936-pt1.patch" "8ae673f34a5b" "1rlbihckl9afa0y91lqs7gpnv6a7zxzrmxjv95y3yrl03kibqp76") ;CVE-2016-9904-pt1
|
||||
(mozilla-patch "icecat-bug-1317936-pt2.patch" "409c23c144fe" "05kgs16y8s5pxmg2dxp93247zagnj6zgj3209qpm5hz3an7gr13h") ;CVE-2016-9904-pt2
|
||||
(mozilla-patch "icecat-bug-1319122.patch" "994d9bd0e28d" "007wifyx3b2ln4fwv1i8n24yz5ngjf4mkzd7sqr5bpd3q88ff293") ;CVE-2016-9900
|
||||
(mozilla-patch "icecat-bug-1312609.patch" "0fc43af8982e" "0pc8q9knzq2knj723mwkay1lnzbzysb07ygxnc16mcb6f7vl2mw8") ;CVE-2016-9893-pt2
|
||||
(mozilla-patch "icecat-bug-1319524.patch" "19f9a4643d77" "0w5yxj1l0hvs66q9agjp4m5sfby7fj05lx33gaqf899bw4hn4vcf") ;CVE-2016-9893-pt3
|
||||
(mozilla-patch "icecat-bug-1312548.patch" "c58442c414f5" "1z1w1v8xagkhrwgp51ij1k2gx0ripslia09vm78812n7gcwddaas") ;CVE-2016-9893-pt4
|
||||
(mozilla-patch "icecat-bug-1314442.patch" "5054047b7328" "0xlw8irymfp3bcaa5jpf7clf7bq6qxp3i8zapp8jya8lzr1nf868") ;CVE-2016-9898
|
||||
(mozilla-patch "icecat-bug-881832-pt1.patch" "1123263318a3" "1qkxwva3zrcs1zhga8ncmndq03988dx75i896g53gbvpskj06915")
|
||||
(mozilla-patch "icecat-bug-881832-pt2.patch" "dc87c0a39adf" "01rapf14f3r2wk0cjd16dn1rll4ipgs33cnjmjck48nvk67ikz6h")
|
||||
(mozilla-patch "icecat-bug-881832-pt3.patch" "f20e5f488368" "15ql9ywifb3gm2g1057k63f821dbs3wqsh3zhndprzf3dn6aha4i")
|
||||
(mozilla-patch "icecat-bug-881832-pt4.patch" "7950c4d5bd7c" "0jhkg5hq5yfy7rh21k1mpbsbr81ql85aazym30zy3n2cf28xxhd7")
|
||||
(mozilla-patch "icecat-bug-881832-pt5.patch" "972734ec21b6" "073i4v1f1ydy49i57pvzscz95sjr5bbk9s5sajxvmmcsmwhpjdfy")
|
||||
(mozilla-patch "icecat-bug-1293985-pt1.patch" "aebd3687e05e" "1qz6hdgflcrqyg7fv66cbg23v4b7q5bc2yxzrgjxs4j1d7jy1s0s") ;CVE-2016-9905-pt1
|
||||
(mozilla-patch "icecat-bug-1293985-pt2.patch" "63d8e5cd27cb" "11fsgyngy7v59ma30xdbmycwf4izwikzvaljngm3ks4534inpl4a") ;CVE-2016-9905-pt2
|
||||
(mozilla-patch "icecat-bug-1279202.patch" "e560997291af" "1hn35slasfcj3ryka4fsarx4l9r99z0iwj67fmbv6zxz4z133kks")
|
||||
(mozilla-patch "icecat-bug-1320039.patch" "21c615b65048" "0ibgsxa36x9ajn2jqbhxxvrfvj6x6iyspsmzzn4brdz11n93skhr") ;CVE-2016-9902
|
||||
(mozilla-patch "icecat-bug-1320057.patch" "c15e5afc0430" "17gj32agqs94548z8lvz0l6zz3kbwajn8as0y4iw5nb6jsll4c66") ;CVE-2016-9901
|
||||
(mozilla-patch "icecat-bug-1163212.patch" "46163fb1cb34" "1yikayczfgfla3aka0159apq3149d52sgvlca0sivx4myd0lvjm7") ;CVE-2016-9893-pt5
|
||||
(mozilla-patch "icecat-bug-1317805.patch" "cde2a37100f5" "100abggnhwyw84almxrkxqfpyfkd4pqkcrh5y9g4d3jd2h16asvl") ;CVE-2016-9893-pt6
|
||||
(mozilla-patch "icecat-bug-1298773-pt1.patch" "9b78ab1e6d07" "19ib6bp96xk000ll40b8qxvizkncyzclz2rsb9w5fa42qs9978ff") ;CVE-2016-9893-pt7
|
||||
(mozilla-patch "icecat-bug-1298773-pt2.patch" "78ebf9c9dfb0" "1shgr4rk6r2zxr1qqk1j3qnnqzqxnbi093qhlrfh8q5q1ivqf6k1") ;CVE-2016-9893-pt8
|
||||
(mozilla-patch "icecat-bug-1299098.patch" "a46a9f16823c" "0dwkyz3kcqnfcbhbfh2lss7s0yh87rgzb871qxx3x4ynyqph9mnz") ;CVE-2016-9893-pt9
|
||||
(mozilla-patch "icecat-bug-1311687.patch" "6bc7cc7a33a6" "1wggcqv84n8mp7xps7hy4rwy61fkh45imfqzc0b46s3w5hyhypn2")
|
||||
(mozilla-patch "icecat-bug-1287912.patch" "778f65148b40" "0j2a153sk0654vv2lnxjib4lwml3mlqn6vs46c2pp82iba8nyfrm") ;CVE-2016-9893-pt10
|
||||
(mozilla-patch "icecat-bug-1312272.patch" "94bd2b43c766" "10h0qpr6m9cqyqxxnkbb6mzb3cagavzlynkxgd7a4izyq1bv28rk") ;CVE-2016-9895
|
||||
(mozilla-patch "icecat-bug-1315631.patch" "893de7431d51" "11gyik8mwipl6ipypkvdq519pw7ccbg0g0bnvxb7271n44cqqcq5"))) ;CVE-2016-9893-pt11
|
||||
(mozilla-patch "icecat-CVE-2016-9897.patch" "2e5438a92617" "0pyjbzyy04759ldpcar8q8cccv67j1jkxsg46rkq7a3rbhmwmw4p")
|
||||
(mozilla-patch "icecat-CVE-2016-9899.patch" "7391f60fb790" "1hydggpmmm2cs9lb15micnkxn4wl4cda9g74hkn3zmks805vjz3h")
|
||||
(mozilla-patch "icecat-CVE-2016-9893-pt1.patch" "744e01001e6e" "0z2fq765kap3ll9as5rvjpnbj3pw26074alw7df0zi215qz47nxr")
|
||||
(mozilla-patch "icecat-CVE-2016-9904-pt1.patch" "8ae673f34a5b" "1rlbihckl9afa0y91lqs7gpnv6a7zxzrmxjv95y3yrl03kibqp76")
|
||||
(mozilla-patch "icecat-CVE-2016-9904-pt2.patch" "409c23c144fe" "05kgs16y8s5pxmg2dxp93247zagnj6zgj3209qpm5hz3an7gr13h")
|
||||
(mozilla-patch "icecat-CVE-2016-9900.patch" "994d9bd0e28d" "007wifyx3b2ln4fwv1i8n24yz5ngjf4mkzd7sqr5bpd3q88ff293")
|
||||
(mozilla-patch "icecat-CVE-2016-9893-pt2.patch" "0fc43af8982e" "0pc8q9knzq2knj723mwkay1lnzbzysb07ygxnc16mcb6f7vl2mw8")
|
||||
(mozilla-patch "icecat-CVE-2016-9893-pt3.patch" "19f9a4643d77" "0w5yxj1l0hvs66q9agjp4m5sfby7fj05lx33gaqf899bw4hn4vcf")
|
||||
(mozilla-patch "icecat-CVE-2016-9893-pt4.patch" "c58442c414f5" "1z1w1v8xagkhrwgp51ij1k2gx0ripslia09vm78812n7gcwddaas")
|
||||
(mozilla-patch "icecat-CVE-2016-9898.patch" "5054047b7328" "0xlw8irymfp3bcaa5jpf7clf7bq6qxp3i8zapp8jya8lzr1nf868")
|
||||
(mozilla-patch "icecat-bug-881832-pt1.patch" "1123263318a3" "1qkxwva3zrcs1zhga8ncmndq03988dx75i896g53gbvpskj06915")
|
||||
(mozilla-patch "icecat-bug-881832-pt2.patch" "dc87c0a39adf" "01rapf14f3r2wk0cjd16dn1rll4ipgs33cnjmjck48nvk67ikz6h")
|
||||
(mozilla-patch "icecat-bug-881832-pt3.patch" "f20e5f488368" "15ql9ywifb3gm2g1057k63f821dbs3wqsh3zhndprzf3dn6aha4i")
|
||||
(mozilla-patch "icecat-bug-881832-pt4.patch" "7950c4d5bd7c" "0jhkg5hq5yfy7rh21k1mpbsbr81ql85aazym30zy3n2cf28xxhd7")
|
||||
(mozilla-patch "icecat-bug-881832-pt5.patch" "972734ec21b6" "073i4v1f1ydy49i57pvzscz95sjr5bbk9s5sajxvmmcsmwhpjdfy")
|
||||
(mozilla-patch "icecat-CVE-2016-9905-pt1.patch" "aebd3687e05e" "1qz6hdgflcrqyg7fv66cbg23v4b7q5bc2yxzrgjxs4j1d7jy1s0s")
|
||||
(mozilla-patch "icecat-CVE-2016-9905-pt2.patch" "63d8e5cd27cb" "11fsgyngy7v59ma30xdbmycwf4izwikzvaljngm3ks4534inpl4a")
|
||||
(mozilla-patch "icecat-bug-1279202.patch" "e560997291af" "1hn35slasfcj3ryka4fsarx4l9r99z0iwj67fmbv6zxz4z133kks")
|
||||
(mozilla-patch "icecat-CVE-2016-9902.patch" "21c615b65048" "0ibgsxa36x9ajn2jqbhxxvrfvj6x6iyspsmzzn4brdz11n93skhr")
|
||||
(mozilla-patch "icecat-CVE-2016-9901.patch" "c15e5afc0430" "17gj32agqs94548z8lvz0l6zz3kbwajn8as0y4iw5nb6jsll4c66")
|
||||
(mozilla-patch "icecat-CVE-2016-9893-pt5.patch" "46163fb1cb34" "1yikayczfgfla3aka0159apq3149d52sgvlca0sivx4myd0lvjm7")
|
||||
(mozilla-patch "icecat-CVE-2016-9893-pt6.patch" "cde2a37100f5" "100abggnhwyw84almxrkxqfpyfkd4pqkcrh5y9g4d3jd2h16asvl")
|
||||
(mozilla-patch "icecat-CVE-2016-9893-pt7.patch" "9b78ab1e6d07" "19ib6bp96xk000ll40b8qxvizkncyzclz2rsb9w5fa42qs9978ff")
|
||||
(mozilla-patch "icecat-CVE-2016-9893-pt8.patch" "78ebf9c9dfb0" "1shgr4rk6r2zxr1qqk1j3qnnqzqxnbi093qhlrfh8q5q1ivqf6k1")
|
||||
(mozilla-patch "icecat-CVE-2016-9893-pt9.patch" "a46a9f16823c" "0dwkyz3kcqnfcbhbfh2lss7s0yh87rgzb871qxx3x4ynyqph9mnz")
|
||||
(mozilla-patch "icecat-bug-1311687.patch" "6bc7cc7a33a6" "1wggcqv84n8mp7xps7hy4rwy61fkh45imfqzc0b46s3w5hyhypn2")
|
||||
(mozilla-patch "icecat-CVE-2016-9893-pt10.patch" "778f65148b40" "0j2a153sk0654vv2lnxjib4lwml3mlqn6vs46c2pp82iba8nyfrm")
|
||||
(mozilla-patch "icecat-CVE-2016-9895.patch" "94bd2b43c766" "10h0qpr6m9cqyqxxnkbb6mzb3cagavzlynkxgd7a4izyq1bv28rk")
|
||||
(mozilla-patch "icecat-CVE-2016-9893-pt11.patch" "893de7431d51" "11gyik8mwipl6ipypkvdq519pw7ccbg0g0bnvxb7271n44cqqcq5")
|
||||
(mozilla-patch "icecat-bug-1323338.patch" "b21dee058b2c" "005khpimffqzas7slajid4dd2c15nyk7rjk6fsps87bgnx0gx0s4")
|
||||
(mozilla-patch "icecat-bug-1258410-pt1.patch" "cd23c5d74be8" "1myzkpzg6pmjacjz8az06m9kz84in1mwsiaw5sgx47pm02598wm5")
|
||||
(mozilla-patch "icecat-bug-1258410-pt2.patch" "b83594617d15" "171cqflc9jh47az96im1whwhyq4ayicspqsczsmn2x5ll9lqw5fq")
|
||||
(mozilla-patch "icecat-bug-1322107.patch" "d6c6f5e4e641" "10x9f46ylm2q3i669hj1csd6agdm8w7xa0iln691z8ayg2hcrxdz")
|
||||
(mozilla-patch "icecat-bug-1285833.patch" "122f5fbfc563" "05pp2f4pg4j8a8pdgjhfrc8g2chhkhsarn9n8sbyag0fy3ig1cvd")
|
||||
(mozilla-patch "icecat-bug-1297361.patch" "297c675ddadc" "1jc1b5i69vq1fvz3qfnnv52c9cj17bjbmfyzmqlw5ywna0wfvabz")
|
||||
(mozilla-patch "icecat-bug-1325877.patch" "3cff736e3bb6" "1nxqwnl9zksvkfkmis7zica4xrhwfndjyy2sxc1dvrh9rshk1swq")
|
||||
(mozilla-patch "icecat-bug-1285960.patch" "2732280adabc" "0zrpq3aybaw2yy38vs6883a4nw01x4kxn3lfqn9yhcgjvngmmyia")
|
||||
(mozilla-patch "icecat-bug-1325938.patch" "81c9fdbd96e8" "0scv1zyi4vbsjdsyj4w70n5jd50baq0dzw3qpxqf1n69nfb9k214")))
|
||||
(modules '((guix build utils)))
|
||||
(snippet
|
||||
'(begin
|
||||
|
||||
@@ -1,6 +1,7 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2013, 2015 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2015 Efraim Flashner <efraim@flashner.co.il>
|
||||
;;; Copyright © 2016 Theodoros Foradis <theodoros.for@openmailbox.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -20,6 +21,7 @@
|
||||
(define-module (gnu packages graphviz)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (guix build-system python)
|
||||
#:use-module (guix download)
|
||||
#:use-module (gnu packages xorg)
|
||||
#:use-module (gnu packages gtk)
|
||||
@@ -30,11 +32,14 @@
|
||||
#:use-module (gnu packages image)
|
||||
#:use-module (gnu packages autotools)
|
||||
#:use-module (gnu packages pkg-config)
|
||||
#:use-module (gnu packages glib)
|
||||
#:use-module (gnu packages gtk)
|
||||
#:use-module (gnu packages gnome)
|
||||
#:use-module (gnu packages fontutils)
|
||||
#:use-module (gnu packages compression)
|
||||
#:use-module (gnu packages gd)
|
||||
#:use-module (gnu packages swig)
|
||||
#:use-module ((guix licenses) #:select (lgpl2.0+ epl1.0)))
|
||||
#:use-module ((guix licenses) #:select (lgpl2.0+ epl1.0 lgpl3+)))
|
||||
|
||||
(define-public graphviz
|
||||
(package
|
||||
@@ -148,3 +153,46 @@ interfaces for other technical domains.")
|
||||
"Library intended to provide a set of useful functions to deal with
|
||||
3D surfaces meshed with interconnected triangles.")
|
||||
(license lgpl2.0+)))
|
||||
|
||||
(define-public xdot
|
||||
(package
|
||||
(name "xdot")
|
||||
(version "0.7")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (pypi-uri "xdot" version))
|
||||
(sha256
|
||||
(base32
|
||||
"1q0f3pskb09saw1qkd2s6vmk80rq5zjhq8l93dfr2x6r04r0q46j"))))
|
||||
(build-system python-build-system)
|
||||
(arguments
|
||||
`(#:phases
|
||||
(modify-phases %standard-phases
|
||||
;; We wrap xdot, so that we don't propagate gtk+ and graphviz
|
||||
(add-after 'install 'wrap
|
||||
(lambda* (#:key inputs outputs #:allow-other-keys)
|
||||
(wrap-program (string-append (assoc-ref outputs "out") "/bin/xdot")
|
||||
`("GI_TYPELIB_PATH" ":" prefix
|
||||
(,(string-append
|
||||
(assoc-ref inputs "gtk+") "/lib/girepository-1.0"
|
||||
":" (assoc-ref inputs "pango") "/lib/girepository-1.0"
|
||||
":" (assoc-ref inputs "gdk-pixbuf") "/lib/girepository-1.0"
|
||||
":" (assoc-ref inputs "atk") "/lib/girepository-1.0")))
|
||||
`("PATH" ":" prefix
|
||||
(,(string-append (assoc-ref inputs "graphviz") "/bin"))))
|
||||
#t)))))
|
||||
(inputs
|
||||
`(("atk" ,atk)
|
||||
("gdk-pixbuf" ,gdk-pixbuf+svg)
|
||||
("graphviz" ,graphviz)
|
||||
("gtk+" ,gtk+)
|
||||
("python-pycairo" ,python-pycairo)
|
||||
("python-pygobject" ,python-pygobject)))
|
||||
(home-page "https://pypi.python.org/pypi/xdot")
|
||||
(synopsis "Interactive viewer for graphviz dot files")
|
||||
(description "Xdot is an interactive viewer for graphs written in
|
||||
@code{graphviz}’s dot language. Internally, it uses the xdot output format as
|
||||
an intermediate format,and @code{gtk} and @code{cairo} for rendering. Xdot can
|
||||
be used either as a standalone application, or as a python library.")
|
||||
(license lgpl3+)))
|
||||
|
||||
@@ -1,6 +1,7 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
|
||||
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
|
||||
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -21,6 +22,7 @@
|
||||
#:use-module (guix licenses)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix git-download)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (gnu packages)
|
||||
#:use-module (gnu packages bison)
|
||||
@@ -56,3 +58,42 @@ formatted output based on formatting commands contained within the text. It
|
||||
is usually the formatter of \"man\" documentation pages.")
|
||||
(license gpl3+)
|
||||
(home-page "http://www.gnu.org/software/groff/")))
|
||||
|
||||
;; There are no releases, so we take the latest commit.
|
||||
(define-public roffit
|
||||
(let ((commit "e5228388e3faf2b7f1ae5bd048ad46ed565304c6")
|
||||
(revision "1"))
|
||||
(package
|
||||
(name "roffit")
|
||||
(version (string-append "0.11-" revision "." (string-take commit 9)))
|
||||
(source (origin
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
(url "https://github.com/bagder/roffit.git")
|
||||
(commit commit)))
|
||||
(file-name (string-append "roffit-" commit "-checkout"))
|
||||
(sha256
|
||||
(base32
|
||||
"1y7ndbqciy7h0khlpi1bv4v1614vhybnmm4jysj6fwxkw9cwv1nc"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
`(#:test-target "test"
|
||||
#:make-flags
|
||||
(list (string-append "INSTALLDIR="
|
||||
(assoc-ref %outputs "out") "/bin"))
|
||||
#:phases
|
||||
(modify-phases %standard-phases
|
||||
(delete 'configure)
|
||||
(add-before 'install 'pre-install
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(mkdir-p (string-append (assoc-ref outputs "out")
|
||||
"/bin"))
|
||||
#t)))))
|
||||
(inputs
|
||||
`(("perl" ,perl)))
|
||||
(home-page "https://daniel.haxx.se/projects/roffit/")
|
||||
(synopsis "Convert nroff files to HTML")
|
||||
(description
|
||||
"Roffit is a program that reads an nroff file and outputs an HTML file.
|
||||
It is typically used to display man pages on a web site.")
|
||||
(license expat))))
|
||||
|
||||
+27
-2
@@ -1,7 +1,7 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
|
||||
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
|
||||
;;; Copyright © 2014, 2015, 2017 Mark H Weaver <mhw@netris.org>
|
||||
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
|
||||
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
|
||||
;;; Copyright © 2015 Paul van der Walt <paul@denknerd.org>
|
||||
@@ -426,6 +426,7 @@ highlighting and other features typical of a source code editor.")
|
||||
(package
|
||||
(name "gdk-pixbuf")
|
||||
(version "2.34.0")
|
||||
(replacement gdk-pixbuf/fixed)
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnome/sources/" name "/"
|
||||
@@ -474,11 +475,35 @@ in the GNOME project.")
|
||||
(license license:lgpl2.0+)
|
||||
(home-page "https://developer.gnome.org/gdk-pixbuf/")))
|
||||
|
||||
(define gdk-pixbuf/fixed
|
||||
(package (inherit gdk-pixbuf)
|
||||
(name "gdk-pixbuf")
|
||||
(version "2.36.3")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnome/sources/" name "/"
|
||||
(version-major+minor version) "/"
|
||||
name "-" version ".tar.xz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1v1rssjd8p5s3lymsfhiq5mbs2pc0h1r6jd0asrwdbrign7i68sj"))))
|
||||
(replacement #f)))
|
||||
|
||||
(define-syntax-rule (package/inherit p overrides ...)
|
||||
"Like (package (inherit P) OVERRIDES ...), except that the same
|
||||
transformation is done to the package replacement, if any. P must be a bare
|
||||
identifier, and will be bound to either P or its replacement when evaluating
|
||||
OVERRIDES."
|
||||
(let loop ((p p))
|
||||
(package (inherit p)
|
||||
overrides ...
|
||||
(replacement (and=> (package-replacement p) loop)))))
|
||||
|
||||
;; To build gdk-pixbuf with SVG support, we need librsvg, and librsvg depends
|
||||
;; on gdk-pixbuf, so this new varibale. Also, librsvg adds 90MiB to the
|
||||
;; closure size.
|
||||
(define-public gdk-pixbuf+svg
|
||||
(package (inherit gdk-pixbuf)
|
||||
(package/inherit gdk-pixbuf
|
||||
(name "gdk-pixbuf+svg")
|
||||
(inputs
|
||||
`(("librsvg" ,librsvg)
|
||||
|
||||
+146
-2
@@ -1,7 +1,7 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
|
||||
;;; Copyright © 2015 Christopher Allan Webber <cwebber@dustycloud.org>
|
||||
;;; Copyright © 2015, 2017 Christopher Allan Webber <cwebber@dustycloud.org>
|
||||
;;; Copyright © 2016 Alex Sassmannshausen <alex@pompo.co>
|
||||
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
|
||||
;;; Copyright © 2016 Erik Edrosa <erik.edrosa@gmail.com>
|
||||
@@ -9,6 +9,7 @@
|
||||
;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
|
||||
;;; Copyright © 2016 Adonay "adfeno" Felipe Nogueira <https://libreplanet.org/wiki/User:Adfeno> <adfeno@openmailbox.org>
|
||||
;;; Copyright © 2016 Amirouche <amirouche@hypermove.net>
|
||||
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -525,6 +526,46 @@ format is also supported.")
|
||||
(,modules)))
|
||||
#t))))))))))))
|
||||
|
||||
(define-public guile-ics
|
||||
(package
|
||||
(name "guile-ics")
|
||||
(version "0.1.1")
|
||||
(source (origin
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
(url "https://github.com/artyom-poptsov/guile-ics")
|
||||
(commit "v0.1.1")))
|
||||
(file-name (string-append name "-" version "-checkout"))
|
||||
(sha256
|
||||
(base32
|
||||
"1pvg6j48inpbq47hq00yh5hhl2qd2srvrx5yjl7w7ky1jsjadp86"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
'(#:phases (modify-phases %standard-phases
|
||||
(add-before 'configure 'autoreconf
|
||||
(lambda _
|
||||
;; Repository comes with a broken symlink
|
||||
(delete-file "README")
|
||||
(symlink "README.org" "README")
|
||||
(zero? (system* "autoreconf" "-fi")))))))
|
||||
(native-inputs
|
||||
`(("autoconf" ,(autoconf-wrapper))
|
||||
("automake" ,automake)
|
||||
("texinfo" ,texinfo)
|
||||
;; Gettext brings 'AC_LIB_LINKFLAGS_FROM_LIBS'.
|
||||
("gettext" ,gettext-minimal)
|
||||
("pkg-config" ,pkg-config)))
|
||||
(inputs `(("guile" ,guile-2.0) ("which" ,which)))
|
||||
(propagated-inputs `(("guile-lib" ,guile-lib)))
|
||||
(home-page "https://github.com/artyom-poptsov/guile-ics")
|
||||
(synopsis "Guile parser library for the iCalendar format")
|
||||
(description
|
||||
"Guile-ICS is an iCalendar (RFC5545) format parser library written in
|
||||
pure Scheme. The library can be used to read and write iCalendar data.
|
||||
|
||||
The library is shipped with documentation in Info format and usage examples.")
|
||||
(license gpl3+)))
|
||||
|
||||
(define-public guile-lib
|
||||
(package
|
||||
(name "guile-lib")
|
||||
@@ -1426,4 +1467,107 @@ type system, elevating types to first-class status.")
|
||||
dictionary and suggesting spelling corrections.")
|
||||
(license gpl3+)))
|
||||
|
||||
(define-public guile-bash
|
||||
;; This project is currently retired. It was initially announced here:
|
||||
;; <https://lists.gnu.org/archive/html/guile-user/2015-02/msg00003.html>.
|
||||
(let ((commit "1eabc563ca5692b3e08d84f1f0e6fd2283284469")
|
||||
(revision "0"))
|
||||
(package
|
||||
(name "guile-bash")
|
||||
(version (string-append "0.1.6-" revision "." (string-take commit 7)))
|
||||
(home-page
|
||||
"https://anonscm.debian.org/cgit/users/kaction-guest/retired/dev.guile-bash.git")
|
||||
(source (origin
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
(commit commit)
|
||||
(url home-page)))
|
||||
(sha256
|
||||
(base32
|
||||
"097vny990wp2qpjij6a5a5gwc6fxzg5wk56inhy18iki5v6pif1p"))
|
||||
(file-name (string-append name "-" version "-checkout"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
'(#:phases (modify-phases %standard-phases
|
||||
(add-after 'unpack 'bootstrap
|
||||
(lambda _
|
||||
(zero? (system* "sh" "bootstrap")))))
|
||||
|
||||
#:configure-flags
|
||||
;; Add -I to match 'bash.pc' of Bash 4.4.
|
||||
(list (string-append "CPPFLAGS=-I"
|
||||
(assoc-ref %build-inputs "bash:include")
|
||||
"/include/bash/include")
|
||||
|
||||
;; The '.a' file is useless.
|
||||
"--disable-static"
|
||||
|
||||
;; Install 'lib/bash' as Bash 4.4 expects.
|
||||
(string-append "--libdir=" (assoc-ref %outputs "out")
|
||||
"/lib/bash"))))
|
||||
(native-inputs `(("pkg-config" ,pkg-config)
|
||||
("autoconf" ,(autoconf-wrapper))
|
||||
("automake" ,automake)
|
||||
("libtool" ,libtool)
|
||||
;; Gettext brings 'AC_LIB_LINKFLAGS_FROM_LIBS'.
|
||||
("gettext" ,gettext-minimal)))
|
||||
(inputs `(("guile" ,guile-2.0)
|
||||
("bash:include" ,bash "include")))
|
||||
(synopsis "Extend Bash using Guile")
|
||||
(description
|
||||
"Guile-Bash provides a shared library and set of Guile modules,
|
||||
allowing you to extend Bash in Scheme. Scheme interfaces allow you to access
|
||||
the following aspects of Bash:
|
||||
|
||||
@itemize
|
||||
@item aliases;
|
||||
@item setting and getting Bash variables;
|
||||
@item creating dynamic variables;
|
||||
@item creating Bash functions with a Scheme implementation;
|
||||
@item reader macro for output capturing;
|
||||
@item reader macro for evaluating raw Bash commands.
|
||||
@end itemize
|
||||
|
||||
To enable it, run:
|
||||
|
||||
@example
|
||||
enable -f ~/.guix-profile/lib/bash/libguile-bash.so scm
|
||||
@end example
|
||||
|
||||
and then run @command{scm example.scm}.")
|
||||
(license gpl3+))))
|
||||
|
||||
(define-public guile-8sync
|
||||
(package
|
||||
(name "guile-8sync")
|
||||
(version "0.4.1")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnu/8sync/8sync-" version
|
||||
".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1fvf8d2s3vvg4nyskbqaiqmlm2x571hv7hizcnmny45zvalydr9h"))))
|
||||
(build-system gnu-build-system)
|
||||
(native-inputs `(("autoconf" ,autoconf)
|
||||
("automake" ,automake)
|
||||
("guile" ,guile-next)
|
||||
("pkg-config" ,pkg-config)
|
||||
("texinfo" ,texinfo)))
|
||||
(arguments
|
||||
`(#:phases (modify-phases %standard-phases
|
||||
(add-before 'configure 'setenv
|
||||
(lambda _
|
||||
;; quiet warnings
|
||||
(setenv "GUILE_AUTO_COMPILE" "0")
|
||||
#t)))))
|
||||
(home-page "https://gnu.org/s/8sync/")
|
||||
(synopsis "Asynchronous actor model library for Guile")
|
||||
(description
|
||||
"GNU 8sync (pronounced \"eight-sync\") is an asynchronous programming
|
||||
library for GNU Guile based on the actor model.
|
||||
|
||||
Note that 8sync is only available for Guile 2.2 (guile-next in Guix).")
|
||||
(license lgpl3+)))
|
||||
|
||||
;;; guile.scm ends here
|
||||
|
||||
+20
-3
@@ -1,6 +1,6 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
|
||||
;;; Copyright © 2013, 2016 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2013, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
@@ -40,8 +40,25 @@
|
||||
(sha256 (base32
|
||||
"0q8s43z14vxm41pfa8s5h9kyyzk1fkwjhkiwbf2x70alm6rv6qi1"))))
|
||||
(build-system gnu-build-system)
|
||||
(propagated-inputs `(("ghostscript" ,ghostscript/x)))
|
||||
(inputs `(("libx11" ,libx11)
|
||||
(arguments
|
||||
'(#:phases (modify-phases %standard-phases
|
||||
(add-before 'configure 'set-gs-file-name
|
||||
(lambda* (#:key inputs #:allow-other-keys)
|
||||
;; Set the value of 'GV.gsInterpreter' in the generated
|
||||
;; 'gv_system.ad' file.
|
||||
(let ((gs (assoc-ref inputs "ghostscript")))
|
||||
(with-fluids ((%default-port-encoding "ISO-8859-1"))
|
||||
(substitute* "src/Makefile.in"
|
||||
(("GV\\.gsInterpreter:([[:blank:]]+)gs" _ blank)
|
||||
(string-append "GV.gsInterpreter:" blank
|
||||
gs "/bin/gs"))
|
||||
(("GV\\.gsCmd([[:alpha:]]+):([[:blank:]]+)gs" _
|
||||
command blank)
|
||||
(string-append "GV.gsCmd" command ":"
|
||||
blank gs "/bin/gs"))))
|
||||
#t))))))
|
||||
(inputs `(("ghostscript" ,ghostscript/x)
|
||||
("libx11" ,libx11)
|
||||
("libxaw3d" ,libxaw3d)
|
||||
("libxinerama" ,libxinerama)
|
||||
("libxpm" ,libxpm)
|
||||
|
||||
+105
-101
@@ -7,7 +7,8 @@
|
||||
;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is>
|
||||
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
|
||||
;;; Copyright © 2015, 2016 Ricardo Wurmus <rekado@elephly.net>
|
||||
;;; Copyright © 2016 David Craven <david@craven.ch>
|
||||
;;; Copyright © 2016, 2017 David Craven <david@craven.ch>
|
||||
;;; Copyright © 2017 Danny Milosavljevic <dannym@scratchpost.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -25,33 +26,34 @@
|
||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gnu packages haskell)
|
||||
#:use-module (ice-9 regex)
|
||||
#:use-module ((guix licenses) #:prefix license:)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix utils)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (guix build-system haskell)
|
||||
#:use-module (gnu packages pkg-config)
|
||||
#:use-module (gnu packages perl)
|
||||
#:use-module (gnu packages bootstrap)
|
||||
#:use-module (gnu packages compression)
|
||||
#:use-module (gnu packages elf)
|
||||
#:use-module (gnu packages gl)
|
||||
#:use-module (gnu packages sdl)
|
||||
#:use-module (gnu packages bootstrap)
|
||||
#:use-module (gnu packages zip)
|
||||
#:use-module (gnu packages gcc)
|
||||
#:use-module (gnu packages ghostscript)
|
||||
#:use-module (gnu packages libffi)
|
||||
#:use-module (gnu packages gl)
|
||||
#:use-module (gnu packages libedit)
|
||||
#:use-module (gnu packages libffi)
|
||||
#:use-module (gnu packages lua)
|
||||
#:use-module (gnu packages maths)
|
||||
#:use-module (gnu packages multiprecision)
|
||||
#:use-module (gnu packages ncurses)
|
||||
#:use-module (gnu packages python)
|
||||
#:use-module (gnu packages pcre)
|
||||
#:use-module (gnu packages perl)
|
||||
#:use-module (gnu packages pkg-config)
|
||||
#:use-module (gnu packages python)
|
||||
#:use-module (gnu packages sdl)
|
||||
#:use-module (gnu packages xml)
|
||||
#:use-module (gnu packages xorg))
|
||||
#:use-module (gnu packages xorg)
|
||||
#:use-module (gnu packages zip)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (guix build-system haskell)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix git-download)
|
||||
#:use-module ((guix licenses) #:prefix license:)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix utils)
|
||||
#:use-module (ice-9 regex))
|
||||
|
||||
(define ghc-bootstrap-x86_64-7.8.4
|
||||
(origin
|
||||
@@ -2200,7 +2202,7 @@ removed. Both IPv4 and IPv6 are supported.")
|
||||
(inputs
|
||||
`(("ghc-mtl" ,ghc-mtl)))
|
||||
(home-page
|
||||
"http://sourceforge.net/projects/lazy-regex")
|
||||
"https://sourceforge.net/projects/lazy-regex")
|
||||
(synopsis "Replaces/Enhances Text.Regex")
|
||||
(description "@code{Text.Regex.Base} provides the interface API for
|
||||
regex-posix, regex-pcre, regex-parsec, regex-tdfa, regex-dfa.")
|
||||
@@ -2223,7 +2225,7 @@ regex-posix, regex-pcre, regex-parsec, regex-tdfa, regex-dfa.")
|
||||
(build-system haskell-build-system)
|
||||
(inputs
|
||||
`(("ghc-regex-base" ,ghc-regex-base)))
|
||||
(home-page "http://sourceforge.net/projects/lazy-regex")
|
||||
(home-page "https://sourceforge.net/projects/lazy-regex")
|
||||
(synopsis "POSIX regular expressions for Haskell")
|
||||
(description "This library provides the POSIX regex backend used by the
|
||||
Haskell library @code{regex-base}.")
|
||||
@@ -2247,7 +2249,7 @@ Haskell library @code{regex-base}.")
|
||||
(inputs
|
||||
`(("ghc-regex-base" ,ghc-regex-base)
|
||||
("ghc-regex-posix" ,ghc-regex-posix)))
|
||||
(home-page "http://sourceforge.net/projects/lazy-regex")
|
||||
(home-page "https://sourceforge.net/projects/lazy-regex")
|
||||
(synopsis "Replaces/Enhances Text.Regex")
|
||||
(description "This library provides one module layer over
|
||||
@code{regex-posix} to replace @code{Text.Regex}.")
|
||||
@@ -6669,87 +6671,6 @@ constant-time:
|
||||
@end enumerate\n")
|
||||
(license license:bsd-3)))
|
||||
|
||||
(define-public idris
|
||||
;; TODO: IDRIS_LIBRARY_PATH only accepts a single path and not a colon
|
||||
;; separated list.
|
||||
;; TODO: When installing idris the location of the standard libraries
|
||||
;; cannot be specified.
|
||||
;; NOTE: Creating an idris build system:
|
||||
;; Idris packages can be packaged and installed using a trivial
|
||||
;; build system.
|
||||
;; (zero? (system* (string-append idris "/bin/idris")
|
||||
;; "--ibcsubdir"
|
||||
;; (string-append out "/idris/libs/lightyear")
|
||||
;; "--install" "lightyear.ipkg")
|
||||
;; (native-search-paths
|
||||
;; (list (search-path-specification
|
||||
;; (variable "IDRIS_LIBRARY_PATH")
|
||||
;; (files '("idris/libs")))))
|
||||
(package
|
||||
(name "idris")
|
||||
(version "0.12.3")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
"https://hackage.haskell.org/package/"
|
||||
"idris-" version "/idris-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1ijrbgzaahw9aagn4al55nqcggrg9ajlrkq2fjc1saq3xdd3v7rs"))))
|
||||
(build-system haskell-build-system)
|
||||
(arguments
|
||||
`(;; FIXME: runhaskell Setup.hs test doesn't set paths required by test
|
||||
;; suite.
|
||||
#:tests? #f
|
||||
#:phases
|
||||
(modify-phases %standard-phases
|
||||
(add-before 'configure 'patch-cc-command
|
||||
(lambda _
|
||||
(setenv "CC" "gcc"))))))
|
||||
(inputs
|
||||
`(("gmp" ,gmp)
|
||||
("ncurses" ,ncurses)
|
||||
("ghc-aeson" ,ghc-aeson)
|
||||
("ghc-async" ,ghc-async)
|
||||
("ghc-annotated-wl-pprint" ,ghc-annotated-wl-pprint)
|
||||
("ghc-ansi-terminal" ,ghc-ansi-terminal)
|
||||
("ghc-ansi-wl-pprint" ,ghc-ansi-wl-pprint)
|
||||
("ghc-base64-bytestring" ,ghc-base64-bytestring)
|
||||
("ghc-blaze-html" ,ghc-blaze-html)
|
||||
("ghc-blaze-markup" ,ghc-blaze-markup)
|
||||
("ghc-cheapskate" ,ghc-cheapskate)
|
||||
("ghc-fingertree" ,ghc-fingertree)
|
||||
("ghc-fsnotify" ,ghc-fsnotify)
|
||||
("ghc-ieee754" ,ghc-ieee754)
|
||||
("ghc-mtl" ,ghc-mtl)
|
||||
("ghc-network" ,ghc-network)
|
||||
("ghc-optparse-applicative" ,ghc-optparse-applicative)
|
||||
("ghc-parsers" ,ghc-parsers)
|
||||
("ghc-regex-tdfa" ,ghc-regex-tdfa)
|
||||
("ghc-safe" ,ghc-safe)
|
||||
("ghc-split" ,ghc-split)
|
||||
("ghc-tasty" ,ghc-tasty)
|
||||
("ghc-tasty-golden" ,ghc-tasty-golden)
|
||||
("ghc-tasty-rerun" ,ghc-tasty-rerun)
|
||||
("ghc-terminal-size" ,ghc-terminal-size)
|
||||
("ghc-text" ,ghc-text)
|
||||
("ghc-trifecta" ,ghc-trifecta)
|
||||
("ghc-uniplate" ,ghc-uniplate)
|
||||
("ghc-unordered-containers" ,ghc-unordered-containers)
|
||||
("ghc-utf8-string" ,ghc-utf8-string)
|
||||
("ghc-vector-binary-instances" ,ghc-vector-binary-instances)
|
||||
("ghc-vector" ,ghc-vector)
|
||||
("ghc-zip-archive" ,ghc-zip-archive)
|
||||
("ghc-zlib" ,ghc-zlib)))
|
||||
(home-page "http://www.idris-lang.org")
|
||||
(synopsis "General purpose language with full dependent types")
|
||||
(description "Idris is a general purpose language with full dependent
|
||||
types. It is compiled, with eager evaluation. Dependent types allow types to
|
||||
be predicated on values, meaning that some aspects of a program's behaviour
|
||||
can be specified precisely in the type. The language is closely related to
|
||||
Epigram and Agda.")
|
||||
(license license:bsd-3)))
|
||||
|
||||
(define-public ghc-base16-bytestring
|
||||
(package
|
||||
(name "ghc-base16-bytestring")
|
||||
@@ -8129,4 +8050,87 @@ for general types.")
|
||||
dependency.")
|
||||
(license license:bsd-3)))
|
||||
|
||||
(define-public ghc-language-c
|
||||
(package
|
||||
(name "ghc-language-c")
|
||||
(version "0.5.0")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "https://hackage.haskell.org/package/"
|
||||
"language-c/language-c-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"08i2bl7jmmymn2sldzlbz6ig7lx3wfwhlpadzibs3fx72z08pmc6"))))
|
||||
(build-system haskell-build-system)
|
||||
(inputs `(("ghc-syb" ,ghc-syb)))
|
||||
(native-inputs
|
||||
`(("ghc-happy" ,ghc-happy)
|
||||
("ghc-alex" ,ghc-alex)))
|
||||
(home-page "http://visq.github.io/language-c/")
|
||||
(synopsis "Analysis and generation of C code")
|
||||
(description
|
||||
"Language C is a Haskell library for the analysis and generation of C code.
|
||||
It features a complete, well-tested parser and pretty printer for all of C99
|
||||
and a large set of GNU extensions.")
|
||||
(license license:bsd-3)))
|
||||
|
||||
(define-public ghc-markdown-unlit
|
||||
(package
|
||||
(name "ghc-markdown-unlit")
|
||||
(version "0.4.0")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
"mirror://hackage/package/markdown-unlit/"
|
||||
"markdown-unlit-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1kj2bffl7ndd8ygwwa3r1mbpwbxbfhyfgnbla8k8g9i6ffp0qrbw"))))
|
||||
(build-system haskell-build-system)
|
||||
(inputs
|
||||
`(("ghc-base-compat" ,ghc-base-compat)
|
||||
("ghc-hspec" ,ghc-hspec)
|
||||
("ghc-quickcheck" ,ghc-quickcheck)
|
||||
("ghc-silently" ,ghc-silently)
|
||||
("ghc-stringbuilder" ,ghc-stringbuilder)
|
||||
("ghc-temporary" ,ghc-temporary)
|
||||
("hspec-discover" ,hspec-discover)))
|
||||
(home-page "https://github.com/sol/markdown-unlit#readme")
|
||||
(synopsis "Literate Haskell support for Markdown")
|
||||
(description "This package allows you to have a README.md that at the
|
||||
same time is a literate Haskell program.")
|
||||
(license license:expat)))
|
||||
|
||||
(define-public corrode
|
||||
(let ((commit "b6699fb2fa552a07c6091276285a44133e5c9789"))
|
||||
(package
|
||||
(name "corrode")
|
||||
(version (string-append "0.0.1-" (string-take commit 7)))
|
||||
(source
|
||||
(origin
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
(url "https://github.com/jameysharp/corrode.git")
|
||||
(commit "b6699fb2fa552a07c6091276285a44133e5c9789")))
|
||||
(file-name
|
||||
(string-append name "-" version "-checkout"))
|
||||
(sha256
|
||||
(base32 "02v0yyj6sk4gpg2222wzsdqjxn8w66scbnf6b20x0kbmc69qcz4r"))))
|
||||
(build-system haskell-build-system)
|
||||
(inputs
|
||||
`(("ghc-language-c" ,ghc-language-c)
|
||||
("ghc-markdown-unlit" ,ghc-markdown-unlit)))
|
||||
(home-page "https://github.com/jameysharp/corrode")
|
||||
(synopsis "Automatic semantics-preserving translation from C to Rust")
|
||||
(description
|
||||
"This program reads a C source file and prints an equivalent module in
|
||||
Rust syntax. It is intended to be useful for two different purposes:
|
||||
|
||||
@enumerate
|
||||
@item Partial automation for migrating legacy code that was implemented in C.
|
||||
@item A new, complementary approach to static analysis for C programs.
|
||||
@end enumerate\n")
|
||||
(license license:gpl2+))))
|
||||
|
||||
;;; haskell.scm ends here
|
||||
|
||||
@@ -28,7 +28,12 @@
|
||||
#:use-module (gnu packages bison)
|
||||
#:use-module (gnu packages perl)
|
||||
#:use-module (gnu packages base)
|
||||
#:use-module (guix git-download))
|
||||
#:use-module (guix git-download)
|
||||
#:export (hurd-triplet?))
|
||||
|
||||
(define (hurd-triplet? triplet)
|
||||
(and (string-suffix? "-gnu" triplet)
|
||||
(not (string-contains triplet "linux"))))
|
||||
|
||||
(define-public gnumach-headers
|
||||
(package
|
||||
|
||||
@@ -0,0 +1,256 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2015 Paul van der Walt <paul@denknerd.org>
|
||||
;;; Copyright © 2016, 2017 David Craven <david@craven.ch>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
||||
;;; under the terms of the GNU General Public License as published by
|
||||
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||
;;; your option) any later version.
|
||||
;;;
|
||||
;;; GNU Guix is distributed in the hope that it will be useful, but
|
||||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;;; GNU General Public License for more details.
|
||||
;;;
|
||||
;;; You should have received a copy of the GNU General Public License
|
||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gnu packages idris)
|
||||
#:use-module (gnu packages haskell)
|
||||
#:use-module (gnu packages multiprecision)
|
||||
#:use-module (gnu packages ncurses)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (guix build-system haskell)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix git-download)
|
||||
#:use-module ((guix licenses) #:prefix license:)
|
||||
#:use-module (guix packages))
|
||||
|
||||
(define-public idris
|
||||
(package
|
||||
(name "idris")
|
||||
(version "0.99")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
"https://hackage.haskell.org/package/"
|
||||
"idris-" version "/idris-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1sd4vy5rx0mp32xj99qijhknkgw4d2rxvz6wiy3pym6kaqmc497i"))))
|
||||
(build-system haskell-build-system)
|
||||
(inputs
|
||||
`(("gmp" ,gmp)
|
||||
("ncurses" ,ncurses)
|
||||
("ghc-aeson" ,ghc-aeson)
|
||||
("ghc-async" ,ghc-async)
|
||||
("ghc-annotated-wl-pprint" ,ghc-annotated-wl-pprint)
|
||||
("ghc-ansi-terminal" ,ghc-ansi-terminal)
|
||||
("ghc-ansi-wl-pprint" ,ghc-ansi-wl-pprint)
|
||||
("ghc-base64-bytestring" ,ghc-base64-bytestring)
|
||||
("ghc-blaze-html" ,ghc-blaze-html)
|
||||
("ghc-blaze-markup" ,ghc-blaze-markup)
|
||||
("ghc-cheapskate" ,ghc-cheapskate)
|
||||
("ghc-fingertree" ,ghc-fingertree)
|
||||
("ghc-fsnotify" ,ghc-fsnotify)
|
||||
("ghc-ieee754" ,ghc-ieee754)
|
||||
("ghc-mtl" ,ghc-mtl)
|
||||
("ghc-network" ,ghc-network)
|
||||
("ghc-optparse-applicative" ,ghc-optparse-applicative)
|
||||
("ghc-parsers" ,ghc-parsers)
|
||||
("ghc-regex-tdfa" ,ghc-regex-tdfa)
|
||||
("ghc-safe" ,ghc-safe)
|
||||
("ghc-split" ,ghc-split)
|
||||
("ghc-tasty" ,ghc-tasty)
|
||||
("ghc-tasty-golden" ,ghc-tasty-golden)
|
||||
("ghc-tasty-rerun" ,ghc-tasty-rerun)
|
||||
("ghc-terminal-size" ,ghc-terminal-size)
|
||||
("ghc-text" ,ghc-text)
|
||||
("ghc-trifecta" ,ghc-trifecta)
|
||||
("ghc-uniplate" ,ghc-uniplate)
|
||||
("ghc-unordered-containers" ,ghc-unordered-containers)
|
||||
("ghc-utf8-string" ,ghc-utf8-string)
|
||||
("ghc-vector-binary-instances" ,ghc-vector-binary-instances)
|
||||
("ghc-vector" ,ghc-vector)
|
||||
("ghc-zip-archive" ,ghc-zip-archive)
|
||||
("ghc-zlib" ,ghc-zlib)))
|
||||
(arguments
|
||||
`(#:tests? #f ; FIXME: Test suite doesn't run in a sandbox.
|
||||
#:configure-flags
|
||||
(list (string-append "--datasubdir="
|
||||
(assoc-ref %outputs "out") "/lib/idris"))
|
||||
#:phases
|
||||
(modify-phases %standard-phases
|
||||
(add-before 'configure 'set-cc-command
|
||||
(lambda _
|
||||
(setenv "CC" "gcc")
|
||||
#t))
|
||||
(add-after 'install 'fix-libs-install-location
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(let* ((out (assoc-ref outputs "out"))
|
||||
(lib (string-append out "/lib/idris"))
|
||||
(modules (string-append lib "/libs")))
|
||||
(for-each
|
||||
(lambda (module)
|
||||
(symlink (string-append modules "/" module)
|
||||
(string-append lib "/" module)))
|
||||
'("prelude" "base" "contrib" "effects" "pruviloj"))))))))
|
||||
(native-search-paths
|
||||
(list (search-path-specification
|
||||
(variable "IDRIS_LIBRARY_PATH")
|
||||
(files '("lib/idris")))))
|
||||
(home-page "http://www.idris-lang.org")
|
||||
(synopsis "General purpose language with full dependent types")
|
||||
(description "Idris is a general purpose language with full dependent
|
||||
types. It is compiled, with eager evaluation. Dependent types allow types to
|
||||
be predicated on values, meaning that some aspects of a program's behaviour
|
||||
can be specified precisely in the type. The language is closely related to
|
||||
Epigram and Agda.")
|
||||
(license license:bsd-3)))
|
||||
|
||||
;; Idris modules use the gnu-build-system so that the IDRIS_LIBRARY_PATH is set.
|
||||
(define (idris-default-arguments name)
|
||||
`(#:modules ((guix build gnu-build-system)
|
||||
(guix build utils)
|
||||
(ice-9 ftw)
|
||||
(ice-9 match))
|
||||
#:phases
|
||||
(modify-phases %standard-phases
|
||||
(delete 'configure)
|
||||
(delete 'build)
|
||||
(delete 'check)
|
||||
(replace 'install
|
||||
(lambda* (#:key inputs outputs #:allow-other-keys)
|
||||
(let* ((out (assoc-ref outputs "out"))
|
||||
(idris (assoc-ref inputs "idris"))
|
||||
(idris-bin (string-append idris "/bin/idris"))
|
||||
(idris-libs (string-append idris "/lib/idris/libs"))
|
||||
(module-name (and (string-prefix? "idris-" ,name)
|
||||
(substring ,name 6)))
|
||||
(ibcsubdir (string-append out "/lib/idris/" module-name))
|
||||
(ipkg (string-append module-name ".ipkg"))
|
||||
(idris-library-path (getenv "IDRIS_LIBRARY_PATH"))
|
||||
(idris-path (string-split idris-library-path #\:))
|
||||
(idris-path-files (apply append
|
||||
(map (lambda (path)
|
||||
(map (lambda (dir)
|
||||
(string-append path "/" dir))
|
||||
(scandir path))) idris-path)))
|
||||
(idris-path-subdirs (filter (lambda (path)
|
||||
(and path (match (stat:type (stat path))
|
||||
('directory #t)
|
||||
(_ #f))))
|
||||
idris-path-files))
|
||||
(install-cmd (cons* idris-bin
|
||||
"--ibcsubdir" ibcsubdir
|
||||
"--install" ipkg
|
||||
(apply append (map (lambda (path)
|
||||
(list "--idrispath"
|
||||
path))
|
||||
idris-path-subdirs)))))
|
||||
(setenv "IDRIS_LIBRARY_PATH" idris-libs)
|
||||
;; FIXME: Seems to be a bug in idris that causes a dubious failure.
|
||||
(apply system* install-cmd)
|
||||
#t))))))
|
||||
|
||||
(define-public idris-lightyear
|
||||
(let ((commit "6d65ad111b4bed2bc131396f8385528fc6b3678a"))
|
||||
(package
|
||||
(name "idris-lightyear")
|
||||
(version (git-version "0.1" "1" commit))
|
||||
(source (origin
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
(url "https://github.com/ziman/lightyear")
|
||||
(commit commit)))
|
||||
(file-name (git-file-name name version))
|
||||
(sha256
|
||||
(base32
|
||||
"1pkxnn3ryr0v0cin4nasw7kgkc9dnnpja1nfbj466mf3qv5s98af"))))
|
||||
(build-system gnu-build-system)
|
||||
(native-inputs
|
||||
`(("idris" ,idris)))
|
||||
(arguments (idris-default-arguments name))
|
||||
(home-page "https://github.com/ziman/lightyear")
|
||||
(synopsis "Lightweight parser combinator library for Idris")
|
||||
(description "Lightweight parser combinator library for Idris, inspired
|
||||
by Parsec. This package is used (almost) the same way as Parsec, except for one
|
||||
difference: backtracking.")
|
||||
(license license:bsd-2))))
|
||||
|
||||
(define-public idris-wl-pprint
|
||||
(let ((commit "1d365fcf4ba075859844dbc5eb96a90f57b9f338"))
|
||||
(package
|
||||
(name "idris-wl-pprint")
|
||||
(version (git-version "0.1" "1" commit))
|
||||
(source (origin
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
(url "https://github.com/shayan-najd/wl-pprint")
|
||||
(commit commit)))
|
||||
(file-name (git-file-name name version))
|
||||
(sha256
|
||||
(base32
|
||||
"0g7c3y9smifdz4sivi3qmvymhdr7v9kfq45fmfmmvkqcrix0spzn"))))
|
||||
(build-system gnu-build-system)
|
||||
(native-inputs
|
||||
`(("idris" ,idris)))
|
||||
(arguments (idris-default-arguments name))
|
||||
(home-page "https://github.com/shayan-najd/wl-pprint")
|
||||
(synopsis "Pretty printing library")
|
||||
(description "A pretty printing library for Idris based on Phil Wadler's
|
||||
paper A Prettier Printer and on Daan Leijen's extensions in the Haskell
|
||||
wl-pprint library.")
|
||||
(license license:bsd-2))))
|
||||
|
||||
(define-public idris-bifunctors
|
||||
(let ((commit "53d06a6ccfe70c49c9ae8c8a4135981dd2173202"))
|
||||
(package
|
||||
(name "idris-bifunctors")
|
||||
(version (git-version "0.1" "1" commit))
|
||||
(source (origin
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
(url "https://github.com/HuwCampbell/Idris-Bifunctors")
|
||||
(commit commit)))
|
||||
(file-name (string-append name "-" version "-checkout"))
|
||||
(sha256
|
||||
(base32
|
||||
"02vbsd3rmgnj0l1qq787709qcxjbr9890cbad4ykn27f77jk81h4"))))
|
||||
(build-system gnu-build-system)
|
||||
(native-inputs
|
||||
`(("idris" ,idris)))
|
||||
(arguments (idris-default-arguments name))
|
||||
(home-page "https://github.com/HuwCampbell/Idris-Bifunctors")
|
||||
(synopsis "Bifunctor library")
|
||||
(description "This is a bifunctor library for Idris based off the
|
||||
excellent Haskell Bifunctors package from Edward Kmett.")
|
||||
(license license:bsd-3))))
|
||||
|
||||
(define-public idris-lens
|
||||
(let ((commit "26f012005f6849806cea630afe317e42cae97f29"))
|
||||
(package
|
||||
(name "idris-lens")
|
||||
(version (git-version "0.1" "1" commit))
|
||||
(source (origin
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
(url "https://github.com/HuwCampbell/idris-lens")
|
||||
(commit commit)))
|
||||
(file-name (git-file-name name version))
|
||||
(sha256
|
||||
(base32
|
||||
"06jzfj6rad08rk92w8jk5byi79svmyg0mrcqhibgx8rkjjy6vmai"))))
|
||||
(build-system gnu-build-system)
|
||||
(native-inputs
|
||||
`(("idris" ,idris)))
|
||||
(propagated-inputs
|
||||
`(("idris-bifunctors" ,idris-bifunctors)))
|
||||
(arguments (idris-default-arguments name))
|
||||
(home-page "https://github.com/HuwCampbell/idris-lens")
|
||||
(synopsis "Van Laarhoven lenses for Idris")
|
||||
(description "Lenses are composable functional references. They allow
|
||||
accessing and modifying data within a structure.")
|
||||
(license license:bsd-3))))
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user