forked from tribes/guix
Compare commits
811 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
| 44941798d2 | |||
| 5131064204 | |||
| 081145cf6e | |||
| bf2479c710 | |||
| c6fabc5e57 | |||
| 02754a5e52 | |||
| 6e206ac788 | |||
| 7e51e5bcf4 | |||
| 024e2c1771 | |||
| 19b396bf31 | |||
| 7b3f6a277c | |||
| 2bc53ba922 | |||
| 29934e0244 | |||
| 2f7d2d9185 | |||
| 7bcf372e84 | |||
| ecde61914e | |||
| 38b19699b2 | |||
| a886404f68 | |||
| 2b1cee21ae | |||
| 3a3278e956 | |||
| f21ca31d15 | |||
| 13d1862632 | |||
| eb59595ccd | |||
| a0e59dd806 | |||
| 48bd76e009 | |||
| cd4a3cb359 | |||
| 4c7ac9aa7f | |||
| c29b69be2d | |||
| d09e8c7b15 | |||
| cd2512bfa3 | |||
| 351d690f37 | |||
| 310081e27e | |||
| a480307449 | |||
| 9de1defe79 | |||
| db719df769 | |||
| 9a0569aafe | |||
| bff39668b9 | |||
| ced0106a44 | |||
| 5c88ac539b | |||
| 3940c5cab3 | |||
| 7f614a747c | |||
| 3fd242e097 | |||
| ceb6b4c2aa | |||
| c43065a8ee | |||
| 5dee9acf53 | |||
| b173d0e443 | |||
| be05e643ae | |||
| 08dbc3b550 | |||
| 0b0fbf0c16 | |||
| dc05f01cba | |||
| a21b42e225 | |||
| 84dfb45821 | |||
| 0ecc3bf309 | |||
| 91781e0268 | |||
| 85c4848fcc | |||
| 8ee0e719bb | |||
| 42de960878 | |||
| 906b1b0986 | |||
| f34c56be3a | |||
| 1306b0b003 | |||
| 594340bc79 | |||
| 380f2ab6a4 | |||
| efe0be6de7 | |||
| 7047133f07 | |||
| 501d764751 | |||
| 342b5204aa | |||
| b118401f71 | |||
| 5220e6200b | |||
| 842f7883f9 | |||
| a6b55314b1 | |||
| bb3b71ce87 | |||
| 9a4d9333e2 | |||
| fdaacbad85 | |||
| 03920078d5 | |||
| b756d3da4c | |||
| d6e2a622c4 | |||
| ccea821bef | |||
| 7eda0c567b | |||
| e1a94b978e | |||
| d9e56454e2 | |||
| f5fd4fd237 | |||
| 0c4b00d851 | |||
| e43d5fa0d7 | |||
| 88faf93315 | |||
| 843858b8a7 | |||
| 37c4ffc2c4 | |||
| e718f6cc8f | |||
| 7be25d4af0 | |||
| 5614921754 | |||
| 054a3921f0 | |||
| bcc046fc87 | |||
| d6f74baf5d | |||
| f81ac34dd9 | |||
| 4684f301d5 | |||
| a2b63d58d4 | |||
| c4bd2aca00 | |||
| 922ea80683 | |||
| b138ec947a | |||
| 28567712f3 | |||
| bfdbaf779f | |||
| 75058ecaea | |||
| 421c3bcc1b | |||
| 99ae9ceb18 | |||
| 810568b35f | |||
| ccdca0a09e | |||
| d8c1944196 | |||
| 6aa260af12 | |||
| a9967103de | |||
| cff1c5c1c6 | |||
| a50fbf0d65 | |||
| 9b24c76802 | |||
| ab11f0bed4 | |||
| c1941588dd | |||
| 91cc5aff5a | |||
| 0fa22d5a7c | |||
| 15a6d433ff | |||
| 105c260f00 | |||
| 431e5f5a3e | |||
| 17854ef91d | |||
| 72b030c049 | |||
| b1e666835e | |||
| 41eb11988e | |||
| 9a130e19fc | |||
| d2e59637e3 | |||
| f703413e41 | |||
| e30442b53b | |||
| 41d07f5e98 | |||
| 3c1f0e3b99 | |||
| 263d05be8d | |||
| c8af8572bf | |||
| 50fe945c01 | |||
| 12bcf94a9a | |||
| 95f92d4e2c | |||
| b1821e8272 | |||
| e4bed284ae | |||
| fae3d34720 | |||
| 84934f40d1 | |||
| 467a3c93db | |||
| 63854bcbb1 | |||
| 98c16943d5 | |||
| 52b321e908 | |||
| 65fb4515f0 | |||
| 6b464e6e5a | |||
| e0622a9c4a | |||
| f9664de768 | |||
| dad287bdba | |||
| 0d011aad10 | |||
| 834ea02ad8 | |||
| 000c59b671 | |||
| 8de1691475 | |||
| 3b1bba4cab | |||
| 342005e7e3 | |||
| 121de2e107 | |||
| d611d0833f | |||
| b77b84717d | |||
| aec149e32a | |||
| 6f885c059c | |||
| cd14b5e3f3 | |||
| ff0a8c590d | |||
| 773bab64e8 | |||
| d38bd08c74 | |||
| 62f261d88c | |||
| 6f7f24092f | |||
| 4f38d922fe | |||
| 17e1ddf697 | |||
| 3c0f23290d | |||
| b38e45d813 | |||
| c37a74bd3e | |||
| 6888830b35 | |||
| 3b509259bf | |||
| d460204f2e | |||
| ac67e20582 | |||
| 47e643db10 | |||
| 05962f2958 | |||
| 50373bab7a | |||
| e786293e76 | |||
| 5c2033f864 | |||
| 833fdac028 | |||
| 43402c5cd2 | |||
| 76c9b6aaef | |||
| edda6db236 | |||
| 488e886384 | |||
| fb7bdb43ef | |||
| 3484d052fa | |||
| a16e9204ad | |||
| 12d39eb514 | |||
| d8805b95f5 | |||
| c268a0d4a6 | |||
| 49aeaedfa7 | |||
| e0ea3f8a0d | |||
| b9113adf45 | |||
| 82350397ed | |||
| e9a6d2252c | |||
| b32c8549e4 | |||
| 7591698210 | |||
| 4797d84ddb | |||
| 283fd55b41 | |||
| 609578a7d0 | |||
| c70cf7eb07 | |||
| 27383915ce | |||
| be2c88caa0 | |||
| 3b23972059 | |||
| 83aabfbcc6 | |||
| 7dbe096c63 | |||
| 940a8c57be | |||
| d2d0514b58 | |||
| e6740741d1 | |||
| a96a82d79e | |||
| 4902c3ecc6 | |||
| 9d3074609a | |||
| fc93e30919 | |||
| 31a123fe00 | |||
| 791e0126ae | |||
| bc36105651 | |||
| 7491edafdb | |||
| f15615b119 | |||
| 77b0ac905d | |||
| f47638a353 | |||
| 2d7bf94927 | |||
| 17b50485a6 | |||
| f209da9f94 | |||
| ce2e4e3938 | |||
| d2b299a91f | |||
| 8a96bd4bb0 | |||
| 537c8bb3fc | |||
| eeb3703db5 | |||
| 4e2f98c539 | |||
| 6becfdff76 | |||
| 218ee89b0c | |||
| b94ae0b89e | |||
| fa35dafe9a | |||
| bed9307062 | |||
| 8835aed4ad | |||
| 35b9e4232c | |||
| 3c42965b1e | |||
| 903581f971 | |||
| 334c43e354 | |||
| 574e847b8e | |||
| c04b82ffce | |||
| 86a4126348 | |||
| ec322be248 | |||
| 822efdff8a | |||
| 3435266298 | |||
| 1d1efa6c6a | |||
| 16755848fc | |||
| e102df2812 | |||
| c57a6e4cd5 | |||
| 459cad2311 | |||
| 6178ae9cb7 | |||
| f9e687b51a | |||
| 569ac04681 | |||
| 23466647a8 | |||
| 47bc885c2c | |||
| 68b18aae6a | |||
| a5ffa812b8 | |||
| cf690129b4 | |||
| 388fd01b02 | |||
| 05b4226ad9 | |||
| 1454a2ba88 | |||
| 7947a05439 | |||
| 45c151d9b4 | |||
| 9a9f1003ae | |||
| 29a7c98a42 | |||
| 38bf090e7c | |||
| d99e12d247 | |||
| 23459fa59b | |||
| 7c3c0374de | |||
| 67a86d3b8d | |||
| 1d830bc0c2 | |||
| e5997888fa | |||
| 8dcec91426 | |||
| 3d7d17b318 | |||
| 969df97487 | |||
| e25408849a | |||
| bd53d327e1 | |||
| 189cea2782 | |||
| 347e17b474 | |||
| fd2b6df2a8 | |||
| 49d758d212 | |||
| 063b60be7b | |||
| dd7c013d4b | |||
| 51861587c6 | |||
| 11c38cbe0d | |||
| 998fb8fa1d | |||
| 8601d0ddcf | |||
| 1391dcb054 | |||
| 3de9a5936c | |||
| 6aad2d625f | |||
| af874238d4 | |||
| c2379b3c1f | |||
| 0546393164 | |||
| 7d09fb3464 | |||
| 817efe8bb1 | |||
| e3703818db | |||
| 3ad9a0b1e7 | |||
| 78a90c7f47 | |||
| 572bcdf0bc | |||
| 14e84b2d97 | |||
| fac8b30bf8 | |||
| abc5b82971 | |||
| b3bb82f154 | |||
| 3ccde08752 | |||
| c0c018f180 | |||
| 1b7d5242c3 | |||
| 36ae58488b | |||
| b3f3fb825e | |||
| a0e9b72e44 | |||
| 50d74f3964 | |||
| 2793c0fb26 | |||
| d53e8ba6b5 | |||
| fddbf35bf5 | |||
| d8b85b7d42 | |||
| 58d08c369b | |||
| 372c4bbcbb | |||
| e25234e34b | |||
| 7313a52e7a | |||
| c678a4eef6 | |||
| 7239828d29 | |||
| 5d7a8584f5 | |||
| 12703d0854 | |||
| 0363991a25 | |||
| 4938b0eead | |||
| 9176607ec4 | |||
| 74c7af9fb8 | |||
| 405a9d4ec9 | |||
| 2e1bafb034 | |||
| 9c814b828a | |||
| 3afcf52be8 | |||
| c824d34fae | |||
| ae133b89cc | |||
| 36160ebbfb | |||
| be3425e5a9 | |||
| fb59e275dd | |||
| 3c762a13bf | |||
| a00ffdaa17 | |||
| 8202a51313 | |||
| 5622953de1 | |||
| 90d104ba82 | |||
| 0c115d8c64 | |||
| f945bf06af | |||
| 5277dbb062 | |||
| ee69f85c7d | |||
| fa0c1d6104 | |||
| 568841d491 | |||
| c28ba7aa60 | |||
| eb564fc389 | |||
| cb90e7e0eb | |||
| 235c4ec30a | |||
| 2de52589dd | |||
| 80059f54d9 | |||
| 475992f20d | |||
| 177088a3f3 | |||
| 1f06b28899 | |||
| 75af27f764 | |||
| 4e097f8606 | |||
| 288dca55a8 | |||
| 108e0c6101 | |||
| b0d1f10b5e | |||
| 8c43746f35 | |||
| 04a6e43755 | |||
| f410c11076 | |||
| 553521d27c | |||
| 708be46bfd | |||
| 8fa9ff20a8 | |||
| 22e47b640e | |||
| cb6a5c71d8 | |||
| d3d337d2d8 | |||
| b4469d8c12 | |||
| cdb4b4b3ed | |||
| 0d5a559f0f | |||
| 2348fd0f51 | |||
| 5e1103821a | |||
| b72a312c30 | |||
| 881c3f0163 | |||
| 4d96439d08 | |||
| ff212a5cdf | |||
| 9849cfc12c | |||
| 3dcd78109c | |||
| 7998200258 | |||
| 4a44d7bbc6 | |||
| 882383a9aa | |||
| b497a85be8 | |||
| 2a9a4fb8b7 | |||
| 4b91ce2974 | |||
| 98caed035f | |||
| b62fe07f3d | |||
| eff5f452b0 | |||
| 6d7328b2f1 | |||
| 8505493266 | |||
| e596ab0f24 | |||
| 1b3e968512 | |||
| 2efb3ddaa4 | |||
| 6602576e84 | |||
| 9ffc1c00e5 | |||
| 34942e9597 | |||
| 2d5d63d718 | |||
| b5f4bb855d | |||
| 335bc6833f | |||
| 182d6311c2 | |||
| acf735f2be | |||
| c08f9818f9 | |||
| 6ef8c59a7a | |||
| 3472bb20c5 | |||
| 2e269860c4 | |||
| ce8b295352 | |||
| 79f5dd5915 | |||
| 29a61bd0a5 | |||
| 47e225cde8 | |||
| fcb0109d09 | |||
| d22d72fc50 | |||
| 274da61d51 | |||
| a0efb39ad4 | |||
| 319e2d1736 | |||
| 68dddcad62 | |||
| ecb26c101e | |||
| dc47939172 | |||
| a9638ac413 | |||
| 596fcbf768 | |||
| 6c4a2884b6 | |||
| 17b9d16fa2 | |||
| 38877bf346 | |||
| 237c048609 | |||
| 483ca9d88d | |||
| 5520c94c94 | |||
| 53f896f23f | |||
| f36afe4d05 | |||
| dd0b0e681b | |||
| 05681d7388 | |||
| b5c5d763ca | |||
| 223ecaba7f | |||
| f7d28082bb | |||
| 76d88cfa57 | |||
| fddb640971 | |||
| c1fe82d586 | |||
| ce517b20d4 | |||
| 27afb11a22 | |||
| 3f6f7b36d3 | |||
| a54a237b5f | |||
| 81b339fe31 | |||
| dfeb023927 | |||
| 8689901f95 | |||
| 300868ba57 | |||
| c107b54108 | |||
| 84836a5733 | |||
| df354a771d | |||
| b5b73a8269 | |||
| c3f16c554e | |||
| 99462faca0 | |||
| 4627a46470 | |||
| b5d9beaa1a | |||
| c9d39df937 | |||
| 969b662128 | |||
| 3b0273885b | |||
| 4b164c4532 | |||
| f07aa672fd | |||
| 52ac153e2a | |||
| 8591fae4cf | |||
| 077bd18d22 | |||
| cb150ca34f | |||
| 886cf584db | |||
| f452e8ff10 | |||
| de1c158f32 | |||
| e2b464b7f4 | |||
| 5f36ea03ad | |||
| cc7f4e0589 | |||
| a69bc0103d | |||
| 573a35541f | |||
| 571a0310ff | |||
| 0a9e9a6311 | |||
| dd68dd137a | |||
| 46025e94cd | |||
| b1fea30339 | |||
| 4359378a2c | |||
| f75426d5b4 | |||
| a9eef4d2e5 | |||
| 516e93f8a6 | |||
| 49e4bca583 | |||
| 7f28bf9a43 | |||
| 6c1df0819c | |||
| dbcb0ab1a9 | |||
| 2a13d05e45 | |||
| 715fc9d44d | |||
| 510f9d8624 | |||
| 722554a306 | |||
| cb823dd279 | |||
| 2f7a10db6d | |||
| 6904ecce5f | |||
| c8bf8b2f88 | |||
| f02f65efb4 | |||
| 6a3f4c74fd | |||
| d656c14ec9 | |||
| 66d5d8c072 | |||
| bebc8681c2 | |||
| 736755e21e | |||
| 57db49cc3e | |||
| e617a86137 | |||
| d6af251868 | |||
| 64a4a21e86 | |||
| 3f9d63df13 | |||
| a34cedc45e | |||
| 6b8e828577 | |||
| 2274b8163a | |||
| c0b390ed72 | |||
| 38c55e5c8e | |||
| 8d9872b539 | |||
| a023cca8d9 | |||
| 4d54785c69 | |||
| 973eea3478 | |||
| 7585016f53 | |||
| 150d8e6414 | |||
| 5975881687 | |||
| 24e752c097 | |||
| c041886d92 | |||
| de61113857 | |||
| 9fac9e3be3 | |||
| d7ab698a62 | |||
| 9e771e3bb6 | |||
| c5779c931b | |||
| bed035c560 | |||
| 6bddfbc98d | |||
| 8a7330fd76 | |||
| 66a99a0676 | |||
| ba544e78dc | |||
| 52bd573421 | |||
| c19ce3a711 | |||
| dc2d59afa9 | |||
| 9a4efac9ef | |||
| b0e652d836 | |||
| 9d77da2a47 | |||
| 7fa715e783 | |||
| c9a8ad8477 | |||
| 6d49355d8b | |||
| ddfc2fd8e0 | |||
| a68c69675f | |||
| 07b08343d7 | |||
| 7d6a52c0dc | |||
| 66ea98e321 | |||
| 5dae0186de | |||
| ee7bae3bbd | |||
| c851400bee | |||
| ee248b6a70 | |||
| ecd06ca9fa | |||
| c65e183403 | |||
| f9d53de105 | |||
| c6a0536d08 | |||
| 286cacaded | |||
| 095f4deb4b | |||
| f489668723 | |||
| 66fdf54587 | |||
| 9493176ad7 | |||
| d5b888fa2d | |||
| c361d075d3 | |||
| 00d908db1e | |||
| 275a77113c | |||
| c4634dfa26 | |||
| f2817d4303 | |||
| a4888e2e0f | |||
| 6e4532e8fe | |||
| 6bb08d056e | |||
| bde7eb8f0a | |||
| df5ce088f2 | |||
| 757d5ff306 | |||
| a3c4aa1b70 | |||
| 698d228001 | |||
| 52910ded6c | |||
| 1deac3440c | |||
| 9ffbe2b7d5 | |||
| efa77baf26 | |||
| b005157c9b | |||
| cf31157fb2 | |||
| 42d10464be | |||
| df650fa84e | |||
| 1621cf97aa | |||
| 70608adb4a | |||
| c2619e10ea | |||
| c4492a16ea | |||
| 813caa0a66 | |||
| 91cc37a1e3 | |||
| da5538ef44 | |||
| db60b1d9ff | |||
| 5f96f303eb | |||
| 971863fb45 | |||
| 39ccbfad1c | |||
| e759c0a38c | |||
| 4a4cbd0bdd | |||
| 84da4ad4b0 | |||
| e46db7728d | |||
| 49fa9381b8 | |||
| 1456cff18f | |||
| b53833b2ef | |||
| 108293c5ea | |||
| 8ed08c7602 | |||
| 8dd09fad52 | |||
| 9dd6078d3b | |||
| fb35b7c088 | |||
| 3580ab8be2 | |||
| fe34f0d152 | |||
| 8176d4d55b | |||
| 5731cae394 | |||
| ec5dbb5c30 | |||
| 2cec1f6f56 | |||
| 6d45fef43e | |||
| 041358fb01 | |||
| 243a009ada | |||
| b24a0c00e4 | |||
| cd49454b7b | |||
| 070ab0588c | |||
| dac79ecc51 | |||
| 5bf3afea68 | |||
| d8fa80e13f | |||
| 84d2401728 | |||
| 855d4761a5 | |||
| 542ad60fbc | |||
| 6cd9c35637 | |||
| 4435427e6d | |||
| c15a5c0eac | |||
| 56ea0efd72 | |||
| 850189b839 | |||
| 864b5211cd | |||
| e6cfbd364a | |||
| 3a1f9a68e5 | |||
| d5f89b22d8 | |||
| c7303d3cef | |||
| b50c5b7418 | |||
| 1145938496 | |||
| 6fd1a79674 | |||
| b21a1c5a18 | |||
| 39c4563aea | |||
| 457f60fa06 | |||
| a423555d3c | |||
| fbb3555809 | |||
| e2f4b305d0 | |||
| 8a9e21d1f7 | |||
| 548f7a8fa2 | |||
| 141360b5b2 | |||
| b002e9d08e | |||
| 52bd0810a8 | |||
| b4f5e0e87c | |||
| 5e3b388b51 | |||
| 3af2d27eb3 | |||
| bf2a56f8ec | |||
| 9a91476431 | |||
| ef8993e2dc | |||
| fa747b27fc | |||
| 8b8ea80781 | |||
| 86da684c3d | |||
| f0214ece31 | |||
| 7239e41196 | |||
| 5c97df3ae6 | |||
| ad14d9e79d | |||
| e23f14fe0c | |||
| deae6e9e6f | |||
| d474d5d0c6 | |||
| 4720f524fc | |||
| ab3893d713 | |||
| 44d43c7a85 | |||
| 79601521fc | |||
| 6646747c02 | |||
| b9a31d90e9 | |||
| b1e48f222b | |||
| 00b7776c0d | |||
| b5ef82e064 | |||
| c00a9fbfef | |||
| dd16424466 | |||
| 9e9cb0c7ba | |||
| ba5324c30e | |||
| b1da9f82a8 | |||
| 83291101c3 | |||
| c23372131d | |||
| 12507a3ee6 | |||
| 49710cea4c | |||
| bdb36958fb | |||
| 5c3eb14e07 | |||
| 2f0556ae5e | |||
| 384de55233 | |||
| 18311966d1 | |||
| af9142dce0 | |||
| f5beb0caf3 | |||
| d17ef35620 | |||
| 48abd13021 | |||
| 5cc4517590 | |||
| c2815c0f46 | |||
| 6b3342af59 | |||
| c6df09941b | |||
| bcac69f674 | |||
| bc0506f5b7 | |||
| c198872b99 | |||
| 8a0576f175 | |||
| 8f5708c1d8 | |||
| ce3e35ed6a | |||
| f0dafadcfc | |||
| 460f97f8fd | |||
| bc67269487 | |||
| 6119ebf194 | |||
| c1bc358f29 | |||
| 90a063f4ca | |||
| 79ee406d51 | |||
| 6b74bb0ae3 | |||
| fa5731baab | |||
| c3114b7567 | |||
| cc69516cdd | |||
| 4ea444198d | |||
| 06a70dbec1 | |||
| 647cfda83b | |||
| cba95006a6 | |||
| 785c33e3af | |||
| a23276cd8b | |||
| 8174e9b7ae | |||
| b211a66163 | |||
| 89caec6920 | |||
| 343745c80a | |||
| 667b250846 | |||
| 68a61e9ffb | |||
| c90ddc8f81 | |||
| 4231f05bbc | |||
| 65f88b2085 | |||
| cdf2b28654 | |||
| f798837f9e | |||
| 975071449c | |||
| d7b4677f79 | |||
| ffbf749e6a | |||
| cb8b285adf | |||
| b9b8607824 | |||
| c0b9213dbb | |||
| 25290d2766 | |||
| 6f22f3c954 | |||
| ae2189a9f2 | |||
| ce33631f54 | |||
| 89925972fb | |||
| 18d2621008 | |||
| fe4163f351 | |||
| 9a4c971521 | |||
| 75f3b1a12d | |||
| 74dde9e919 | |||
| 87eabd5ca7 | |||
| 93c5b1fe1f | |||
| e6a83df11b | |||
| 66269d4786 | |||
| 2f7f32003f | |||
| e69a4dd047 | |||
| d41bb065c8 | |||
| 734939a5f3 | |||
| d34736c5c3 | |||
| dfd1d5edf6 | |||
| b36fcf9550 | |||
| f48624fc68 | |||
| f755403014 | |||
| 599f146400 | |||
| d759cf6774 | |||
| 51152cd125 | |||
| 4a3e602c72 | |||
| 29fce8b6eb | |||
| c5d8376843 | |||
| 3d6e65d529 | |||
| 26c398b182 | |||
| 4acd5c0f9a | |||
| 3a09e1d2e8 | |||
| ebc32b3110 | |||
| 8991a470ea | |||
| c8c85ed7d2 | |||
| 2cabd7d862 | |||
| 0b28f1584f | |||
| 35536412a4 | |||
| 43dd1cf360 | |||
| 4e3a820bfd | |||
| ac995eaf74 | |||
| 1f347f5533 | |||
| b087d41316 | |||
| 30016044e0 | |||
| 13e7ce857c | |||
| 4cf7bd2b7e | |||
| 87806dde17 | |||
| 75f6f74f15 | |||
| 7f767bccf8 | |||
| 352b3bb6e3 | |||
| 1f2b8c886b | |||
| 13c8c2bf13 | |||
| 42dc3af5bf | |||
| f0176a9f18 | |||
| d43d1a7bbf | |||
| 66b93ee14b | |||
| 82fce926f4 | |||
| fe138965af | |||
| d6535cf1db | |||
| a092cd820b | |||
| 8ceaf72c6d | |||
| 684a2f5974 | |||
| 087f67b641 | |||
| c4df90a594 | |||
| 1b13df509e | |||
| 33690ffde5 | |||
| b9663471a8 | |||
| 462f5ccade | |||
| 4ca0b4101d | |||
| a54c94a40d | |||
| 48704e5b5c | |||
| f280cdb1ba | |||
| f8984634fd | |||
| ff838e2ce6 | |||
| 6621cdb65c | |||
| 936229930f | |||
| 1b0a86dd1d | |||
| d43f4296cc | |||
| 5e6feee617 | |||
| 7eade0ee03 | |||
| 5f28f6aab4 | |||
| 445d652916 | |||
| 2f4640e320 | |||
| aaf77acc1a | |||
| 5c47b06b43 | |||
| 00e79195a5 |
+21
-6
@@ -1,7 +1,13 @@
|
||||
;; Per-directory local variables for GNU Emacs 23 and later.
|
||||
|
||||
((nil . ((fill-column . 78)
|
||||
(tab-width . 8)))
|
||||
((nil
|
||||
. ((fill-column . 78)
|
||||
(tab-width . 8)
|
||||
|
||||
;; For use with 'bug-reference-prog-mode'.
|
||||
(bug-reference-url-format . "http://bugs.gnu.org/%s")
|
||||
(bug-reference-bug-regexp
|
||||
. "<https?://\\(debbugs\\|bugs\\)\\.gnu\\.org/\\([0-9]+\\)>")))
|
||||
(c-mode . ((c-file-style . "gnu")))
|
||||
(scheme-mode
|
||||
.
|
||||
@@ -17,6 +23,9 @@
|
||||
(eval . (put 'with-directory-excursion 'scheme-indent-function 1))
|
||||
(eval . (put 'package 'scheme-indent-function 0))
|
||||
(eval . (put 'origin 'scheme-indent-function 0))
|
||||
(eval . (put 'build-system 'scheme-indent-function 0))
|
||||
(eval . (put 'bag 'scheme-indent-function 0))
|
||||
(eval . (put 'graft 'scheme-indent-function 0))
|
||||
(eval . (put 'operating-system 'scheme-indent-function 0))
|
||||
(eval . (put 'file-system 'scheme-indent-function 0))
|
||||
(eval . (put 'manifest-entry 'scheme-indent-function 0))
|
||||
@@ -29,18 +38,24 @@
|
||||
(eval . (put 'call-with-compressed-output-port 'scheme-indent-function 2))
|
||||
(eval . (put 'call-with-decompressed-port 'scheme-indent-function 2))
|
||||
(eval . (put 'signature-case 'scheme-indent-function 1))
|
||||
(eval . (put 'emacs-batch-eval 'scheme-indent-function 0))
|
||||
(eval . (put 'emacs-batch-edit-file 'scheme-indent-function 1))
|
||||
(eval . (put 'emacs-substitute-sexps 'scheme-indent-function 1))
|
||||
(eval . (put 'emacs-substitute-variables 'scheme-indent-function 1))
|
||||
|
||||
(eval . (put 'syntax-parameterize 'scheme-indent-function 1))
|
||||
(eval . (put 'with-monad 'scheme-indent-function 1))
|
||||
(eval . (put 'mbegin 'scheme-indent-function 1))
|
||||
(eval . (put 'mlet* 'scheme-indent-function 2))
|
||||
(eval . (put 'mlet 'scheme-indent-function 2))
|
||||
(eval . (put 'run-with-store 'scheme-indent-function 1))
|
||||
|
||||
;; Recognize '~' and '$', as used for gexps, as quotation symbols. This
|
||||
;; notably allows '(' in Paredit to not insert a space when the preceding
|
||||
;; symbol is one of these.
|
||||
;; Recognize '~', '+', and '$', as used for gexps, as quotation symbols.
|
||||
;; This notably allows '(' in Paredit to not insert a space when the
|
||||
;; preceding symbol is one of these.
|
||||
(eval . (modify-syntax-entry ?~ "'"))
|
||||
(eval . (modify-syntax-entry ?$ "'"))))
|
||||
(eval . (modify-syntax-entry ?$ "'"))
|
||||
(eval . (modify-syntax-entry ?+ "'"))))
|
||||
(emacs-lisp-mode . ((indent-tabs-mode . nil)))
|
||||
(texinfo-mode . ((indent-tabs-mode . nil)
|
||||
(fill-column . 72))))
|
||||
|
||||
@@ -105,3 +105,8 @@ GTAGS
|
||||
/nix-setuid-helper
|
||||
/nix/scripts/guix-authenticate
|
||||
/nix/scripts/offload
|
||||
/emacs/Makefile.in
|
||||
/emacs/Makefile
|
||||
/emacs/guix-autoloads.el
|
||||
/emacs/guix-helper.scm
|
||||
/emacs/guix-init.el
|
||||
|
||||
@@ -9,11 +9,15 @@ The fine people listed below have contributed code to GNU Guix (in
|
||||
alphabetical order):
|
||||
|
||||
Eric Bavier <bavier@member.fsf.org>
|
||||
Taylan Ulrich Bayirli/Kammer <taylanbayirli@gmail.com>
|
||||
Federico Beffa <beffa@fbengineering.ch>
|
||||
Marek Benc <merkur32@gmail.com>
|
||||
Sou Bunnbu (宋文武) <iyzsong@gmail.com>
|
||||
Ludovic Courtès <ludo@gnu.org>
|
||||
John Darrington <jmd@gnu.org>
|
||||
Andreas Enge <andreas@enge.fr>
|
||||
Alírio Eyng <alirioeyng@gmail.com>
|
||||
Guy Grant <gzg@riseup.net>
|
||||
Joshua Grant <tadni@riseup.net>
|
||||
Raimon Grau <raimonster@gmail.com>
|
||||
Nikita Karetnikov <nikita@karetnikov.org>
|
||||
Aljosha Papsch <misc@rpapsch.de>
|
||||
|
||||
@@ -89,6 +89,13 @@ in the form of patches as produced by ‘git format-patch’ sent to
|
||||
guix-devel@gnu.org. Please write commit logs in the [[http://www.gnu.org/prep/standards/html_node/Change-Logs.html#Change-Logs][GNU ChangeLog
|
||||
format]]; you can check the commit history for examples.
|
||||
|
||||
Before submitting a patch that adds or modifies a package definition, please
|
||||
run ‘guix lint PACKAGE’, where PACKAGE is the name of the new or modified
|
||||
package, and fix any errors it reports. In addition, please make sure the
|
||||
package builds on your platform, using ‘guix build’. You may also want to
|
||||
check that dependent package (if applicable) are not affected by the change;
|
||||
‘guix refresh --list-dependent PACKAGE’ will help you do that.
|
||||
|
||||
When posting a patch to the mailing list, use "[PATCH] ..." as a subject. You
|
||||
may use your email client or the ‘git send-mail’ command.
|
||||
|
||||
|
||||
+43
-9
@@ -37,6 +37,7 @@ MODULES = \
|
||||
guix/download.scm \
|
||||
guix/git-download.scm \
|
||||
guix/monads.scm \
|
||||
guix/monad-repl.scm \
|
||||
guix/gexp.scm \
|
||||
guix/profiles.scm \
|
||||
guix/serialization.scm \
|
||||
@@ -46,9 +47,11 @@ MODULES = \
|
||||
guix/licenses.scm \
|
||||
guix/build-system.scm \
|
||||
guix/build-system/cmake.scm \
|
||||
guix/build-system/glib-or-gtk.scm \
|
||||
guix/build-system/gnu.scm \
|
||||
guix/build-system/perl.scm \
|
||||
guix/build-system/python.scm \
|
||||
guix/build-system/ruby.scm \
|
||||
guix/build-system/trivial.scm \
|
||||
guix/ftp-client.scm \
|
||||
guix/http-client.scm \
|
||||
@@ -59,22 +62,25 @@ MODULES = \
|
||||
guix/build/download.scm \
|
||||
guix/build/cmake-build-system.scm \
|
||||
guix/build/git.scm \
|
||||
guix/build/glib-or-gtk-build-system.scm \
|
||||
guix/build/gnu-build-system.scm \
|
||||
guix/build/gnu-dist.scm \
|
||||
guix/build/linux-initrd.scm \
|
||||
guix/build/perl-build-system.scm \
|
||||
guix/build/python-build-system.scm \
|
||||
guix/build/ruby-build-system.scm \
|
||||
guix/build/store-copy.scm \
|
||||
guix/build/utils.scm \
|
||||
guix/build/union.scm \
|
||||
guix/build/pull.scm \
|
||||
guix/build/rpath.scm \
|
||||
guix/build/svn.scm \
|
||||
guix/build/vm.scm \
|
||||
guix/build/install.scm \
|
||||
guix/build/activation.scm \
|
||||
guix/build/syscalls.scm \
|
||||
guix/build/emacs-utils.scm \
|
||||
guix/build/graft.scm \
|
||||
guix/packages.scm \
|
||||
guix/snix.scm \
|
||||
guix/import/utils.scm \
|
||||
guix/import/gnu.scm \
|
||||
guix/import/snix.scm \
|
||||
guix/scripts/download.scm \
|
||||
guix/scripts/build.scm \
|
||||
guix/scripts/archive.scm \
|
||||
@@ -87,6 +93,10 @@ MODULES = \
|
||||
guix/scripts/authenticate.scm \
|
||||
guix/scripts/refresh.scm \
|
||||
guix/scripts/system.scm \
|
||||
guix/scripts/lint.scm \
|
||||
guix/scripts/import/gnu.scm \
|
||||
guix/scripts/import/nix.scm \
|
||||
guix/scripts/environment.scm \
|
||||
guix.scm \
|
||||
$(GNU_SYSTEM_MODULES)
|
||||
|
||||
@@ -97,6 +107,9 @@ MODULES += \
|
||||
|
||||
endif BUILD_DAEMON_OFFLOAD
|
||||
|
||||
# Internal module with test suite support.
|
||||
dist_noinst_DATA = guix/tests.scm
|
||||
|
||||
# Because of the autoload hack in (guix build download), we must build it
|
||||
# first to avoid errors on systems where (gnutls) is unavailable.
|
||||
guix/scripts/download.go: guix/build/download.go
|
||||
@@ -107,9 +120,13 @@ KCONFIGS = \
|
||||
gnu/packages/linux-libre-i686.conf \
|
||||
gnu/packages/linux-libre-x86_64.conf
|
||||
|
||||
GOBJECTS = $(MODULES:%.scm=%.go) guix/config.go
|
||||
# Templates, examples.
|
||||
EXAMPLES = \
|
||||
gnu/system/os-config.tmpl
|
||||
|
||||
nobase_dist_guilemodule_DATA = $(MODULES) $(KCONFIGS)
|
||||
GOBJECTS = $(MODULES:%.scm=%.go) guix/config.go guix/tests.go
|
||||
|
||||
nobase_dist_guilemodule_DATA = $(MODULES) $(KCONFIGS) $(EXAMPLES)
|
||||
nobase_nodist_guilemodule_DATA = $(GOBJECTS) guix/config.scm
|
||||
|
||||
# Do we need to provide our own non-broken (srfi srfi-37) module?
|
||||
@@ -150,7 +167,18 @@ SCM_TESTS = \
|
||||
tests/nar.scm \
|
||||
tests/union.scm \
|
||||
tests/profiles.scm \
|
||||
tests/syscalls.scm
|
||||
tests/syscalls.scm \
|
||||
tests/lint.scm
|
||||
|
||||
if HAVE_GUILE_JSON
|
||||
|
||||
MODULES += \
|
||||
guix/import/pypi.scm \
|
||||
guix/scripts/import/pypi.scm
|
||||
|
||||
SCM_TESTS += tests/pypi.scm
|
||||
|
||||
endif
|
||||
|
||||
SH_TESTS = \
|
||||
tests/guix-build.sh \
|
||||
@@ -160,7 +188,8 @@ SH_TESTS = \
|
||||
tests/guix-package.sh \
|
||||
tests/guix-system.sh \
|
||||
tests/guix-archive.sh \
|
||||
tests/guix-authenticate.sh
|
||||
tests/guix-authenticate.sh \
|
||||
tests/guix-lint.sh
|
||||
|
||||
if BUILD_DAEMON
|
||||
|
||||
@@ -196,6 +225,7 @@ EXTRA_DIST = \
|
||||
ROADMAP \
|
||||
TODO \
|
||||
.dir-locals.el \
|
||||
build-aux/build-self.scm \
|
||||
build-aux/hydra/gnu-system.scm \
|
||||
build-aux/hydra/demo-os.scm \
|
||||
build-aux/hydra/guix.scm \
|
||||
@@ -270,6 +300,10 @@ AM_DISTCHECK_CONFIGURE_FLAGS = \
|
||||
--with-nix-prefix="$(NIX_PREFIX)" \
|
||||
--enable-daemon
|
||||
|
||||
dist_emacsui_DATA = emacs/guix-main.scm
|
||||
nodist_emacsui_DATA = emacs/guix-helper.scm
|
||||
include emacs.am
|
||||
|
||||
dist-hook: sync-descriptions gen-ChangeLog assert-no-store-file-names
|
||||
distcheck-hook: assert-binaries-available assert-final-inputs-self-contained
|
||||
|
||||
|
||||
@@ -10,6 +10,253 @@ Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
||||
|
||||
Please send Guix bug reports to bug-guix@gnu.org.
|
||||
|
||||
* Changes in 0.8 (since 0.7)
|
||||
|
||||
** Package management
|
||||
|
||||
*** New visual user interface in Emacs
|
||||
|
||||
See “Emacs Interface” in the manual.
|
||||
|
||||
*** New ‘guix environment’ command to produce development environment
|
||||
|
||||
See “Invoking guix environment” in the manual.
|
||||
|
||||
*** The ‘guix import’ command has been extended and documented
|
||||
|
||||
It can now import packages from pypi.python.org and from GNU.
|
||||
See “Invoking guix import” in the manual.
|
||||
|
||||
*** New ‘guix lint’ command, for use by Guix developers
|
||||
|
||||
See “Invoking guix lint” in the manual.
|
||||
|
||||
*** Packages can now be “grafted” with replacements of their dependencies
|
||||
|
||||
See “Security Updates” in the manual.
|
||||
|
||||
*** The distribution can be extended with ‘--load-path’ or $GUIX_PACKAGE_PATH
|
||||
|
||||
This allows users to maintain their own package definitions, and make them
|
||||
visible to the various user interfaces. See “Package Modules” in the manual.
|
||||
|
||||
*** ‘guix package’ better reports package upgrades
|
||||
|
||||
*** ‘guix package’ has a new ‘--switch-generation’ option
|
||||
|
||||
See “Invoking guix package” in the manual.
|
||||
|
||||
*** ‘guix-daemon’ has a new ‘--substitute-urls’ option
|
||||
|
||||
See “Invoking guix-daemon” in the manual.
|
||||
|
||||
** Distribution
|
||||
|
||||
*** The stand-alone operating system now supports Linux mapped devices
|
||||
|
||||
See “Mapped Devices” in the manual.
|
||||
|
||||
*** New fields in ‘operating-system’ declarations, better documentation
|
||||
|
||||
New fields include ‘hosts-file’, ‘mapped-devices’, and ‘swap-devices’.
|
||||
See “operating-system Reference” in the manual.
|
||||
|
||||
*** New services: ‘dhcp-client-service’, ‘bitlbee-service’, ‘ntp-service’
|
||||
|
||||
See “Services” in the manual.
|
||||
|
||||
*** Free firmware can be loaded
|
||||
|
||||
This notably enables support for some Atheros-based WiFi devices (ath9k-htc.)
|
||||
See “operating-system Reference” in the manual.
|
||||
|
||||
*** ‘grub-configuration’ declarations can now specify a theme
|
||||
|
||||
See “GRUB Configuration” in the manual.
|
||||
|
||||
*** The ‘base-initrd’ now has a different signature
|
||||
|
||||
Existing uses in ‘operating-system’ declarations need to be updated. See
|
||||
“Initial RAM Disk” in the manual for details.
|
||||
|
||||
*** eudev is now used by default, instead of an old udev release
|
||||
|
||||
*** ‘guix system vm’ has a new ‘--full-boot’ option
|
||||
|
||||
See “Invoking guix system” in the manual.
|
||||
|
||||
*** The ‘file’ command is now part of the package build environment
|
||||
|
||||
Autoconf-generated ‘configure’ scripts for packages using Libtool use ‘file’
|
||||
to determine the target ABI, notably on MIPS, hence this change.
|
||||
|
||||
*** 162 new packages
|
||||
|
||||
abiword, acpica, adns, arb, ath9k-htc-firmware, atlas, avrdude, cppunit,
|
||||
dblatex, detox, dfu-programmer, dionysus, direvent, dmidecode, dri3proto,
|
||||
emacs-no-x-toolkit, emacs-w3m, emacs-wget, enchant, eudev, feh, flashrom,
|
||||
flint, fontforge, freedink, freeimage, fribidi,
|
||||
gcc-cross-sans-libc-xtensa-elf, giblib, gnome-themes-standard, gpsbabel,
|
||||
gpscorrelate, graphite2, gtypist, guile-charting, guile-sdl, imake, imlib2,
|
||||
irrlicht, jbig2dec, libpsl, libspiro, libuninameslist, libwmf, lm-sensors,
|
||||
magit, minetest, miscfiles, mozjs, mupdf, nix, nspr, nss-mdns, ntp, nvi, opam,
|
||||
openal, openjpeg, opus-tools, orpheus, ots, oxygen-icons, paredit, perf,
|
||||
perl-archive-zip, perl-dbd-sqlite, perl-dbi, perl-image-exiftool,
|
||||
perl-io-socket-ssl, perl-net-ssleay, perl-www-curl, perl-zip, polkit,
|
||||
polkit-qt, postgresql, potrace, presentproto, python-certifi, python-coverage,
|
||||
python-cython, python-discover, python-docutils, python-exif-read,
|
||||
python-extras, python-fixtures, python-itsdangerous, python-jinja2,
|
||||
python-jsonschema, python-markupsafe, python-mimeparse, python-nose,
|
||||
python-oauthlib, python-py, python-pygments, python-pyjwt, python-pyld,
|
||||
python-pytest, python-scripttest, python-sphinx, python-subunit,
|
||||
python-testrepository, python-testresources, python-testscenarios,
|
||||
python-testtools, python-unidecode, python-unittest2, python-virtualenv,
|
||||
python2-certifi, python2-coverage, python2-cython, python2-discover,
|
||||
python2-docutils, python2-exif-read, python2-extras, python2-fixtures,
|
||||
python2-itsdangerous, python2-jinja2, python2-jsonschema, python2-markupsafe,
|
||||
python2-mimeparse, python2-nose, python2-oauthlib, python2-py,
|
||||
python2-pygments, python2-pyjwt, python2-pyld, python2-pytest,
|
||||
python2-requests, python2-scripttest, python2-sphinx, python2-subunit,
|
||||
python2-testrepository, python2-testresources, python2-testscenarios,
|
||||
python2-testtools, python2-unidecode, python2-unittest2, python2-virtualenv,
|
||||
rrdtool, ruby, ruby, ruby-i18n, sane-backends, scrot, sound-theme-freedesktop,
|
||||
stress, synergy, tdb, terminus-font, testdisk, texi2html, tiled, transfig,
|
||||
unclutter, unixodbc, weechat, wv, xboing, xf86-video-modesetting, xfig,
|
||||
xsensors, zsh
|
||||
|
||||
*** 117 package updates
|
||||
|
||||
acct-6.6.2, acl-2.2.52, apl-1.4, apr-1.5.1, apr-util-1.5.3, autoconf-2.68,
|
||||
autoconf-2.69, autogen-5.18.4, bash-4.3.30, bash-light-4.3.30, bazaar-2.6.0,
|
||||
bison-2.7, calcurse-3.2.1, ccache-3.1.10, chicken-4.9.0.1, coreutils-8.23,
|
||||
curl-7.37.1, datamash-1.0.6, dbus-1.8.8, docbook-xml-4.2, docbook-xml-4.4,
|
||||
docbook-xml-4.5, emacs-24.4, ffmpeg-2.2.10, ffmpeg-2.4.3, file-5.19,
|
||||
file-5.20, freeipmi-1.4.5, gcc-4.7.4, gcc-4.9.2, gcc-toolchain-4.9.2,
|
||||
gcl-2.6.11, gdb-7.8.1, geiser-0.6, gettext-0.19.3, git-2.1.2, glibc-2.20,
|
||||
glibc-2.20, glibc-stripped-tarball-2.20, global-6.3.2, glpk-4.55,
|
||||
gnupg-1.4.18, gnupg-2.0.26, gnurl-7.37.0, gnutls-3.2.20, gpgme-1.5.1,
|
||||
gst-plugins-base-1.0.10, gstreamer-1.0.10, gtk+-3.10.1, gtkmm-3.9.16,
|
||||
guile-1.8.8, guile-json-0.4.0, guile-ncurses-1.6, guile-ssh-0.7.1, guix-0.7,
|
||||
guix-0.7.48bd76e, hello-2.10, help2man-1.46.3, icecat-31.2.0,
|
||||
libart-lgpl-2.3.21, libassuan-2.1.3, libatomic-ops-7.4.2, libdrm-2.4.33,
|
||||
libffi-3.1, libgc-7.2f, libgc-7.4.2, libgcrypt-1.5.4, libgcrypt-1.6.2,
|
||||
libidn-1.29, libjpeg-9a, libotr-4.0.0, libsodium-1.0.0, libtasn1-4.1,
|
||||
libunistring-0.9.4, libwebsockets-1.3, lightning-2.0.5, linux-libre-3.17.3,
|
||||
lsof-4.88, lua-5.2.3, lvm2-2.02.109, lzip-1.16, make-4.1, maxima-5.34.1,
|
||||
mit-scheme-9.2, mysql-5.1.73, neon-0.30.0, net-base-5.3, nettle-2.7.1,
|
||||
notmuch-0.18.1, openssh-6.7p1, openssl-1.0.1j, parallel-20141022,
|
||||
phonon-4.8.2, pspp-0.8.4, python-3.3.5, python-dateutil-1.5,
|
||||
python2-dateutil-1.5, python2-pyicu-1.8, qt-4.8.6, qt-5.3.2, rcs-5.9.3,
|
||||
readline-6.3, subversion-1.7.18, swig-3.0.2, tar-1.28, texinfo-5.2,
|
||||
tor-0.2.5.10, transmission-2.84, ucommon-6.1.11, valgrind-3.10.0, vlc-2.1.5,
|
||||
wget-1.16, windowmaker-0.95.6, xapian-1.2.18, xf86-video-ati-6.14.6,
|
||||
xpdf-3.04, youtube-dl-2014.09.06
|
||||
|
||||
** Programming interfaces
|
||||
|
||||
*** New ‘ruby-build-system’, for Ruby packages
|
||||
|
||||
See “Build Systems” in the manual.
|
||||
|
||||
*** New ‘glib-or-gtk-build-system’, for packages using GLib schemas
|
||||
|
||||
See “Build Systems” in the manual.
|
||||
|
||||
*** ‘gnu-build-system’ has a new #:substitutable? parameter
|
||||
|
||||
This allows packagers to mark a package as requiring a local build, thus
|
||||
preventing it from being substituted by a pre-built binary.
|
||||
|
||||
*** ‘cmake-build-system’ has a new #:build-type parameter
|
||||
|
||||
See “Build Systems” in the manual.
|
||||
|
||||
*** The ‘supported-systems’ field of packages is used more consistently
|
||||
|
||||
This allows packagers to prevent attempts to build a package on a given
|
||||
architecture when that architecture is known not to be supported. The
|
||||
‘package-transitive-supported-systems’ procedure returns the intersection of
|
||||
the systems supported by the given package and by its dependencies.
|
||||
|
||||
*** The ‘wrap-program’ procedure can now be called multiple times
|
||||
|
||||
*** New ‘graft-derivations’ and ‘package-grafts’ procedures
|
||||
|
||||
They implement “grafts”, as described under “Security Updates” in the manual.
|
||||
|
||||
*** New “bag” intermediate representation for use by build systems
|
||||
|
||||
“Bags” are used internally as an intermediate representation between packages
|
||||
and derivations. See “Build Systems” in the manual.
|
||||
|
||||
*** New (guix monad-repl) module, for monadic interaction at the REPL
|
||||
|
||||
See “The Store Monad” in the manual.
|
||||
|
||||
*** New (guix build emacs-utils) module, to facilitate building Emacs packages
|
||||
|
||||
*** New (guix tests) module, with tools used by the test suite
|
||||
|
||||
*** The internal ‘guix-register’ command now deduplicates files in store items
|
||||
|
||||
*** Several system modules moved from (guix build …) to (gnu build …)
|
||||
|
||||
Also, the (gnu build linux-boot) module has been introduced, with code
|
||||
typically used by initial RAM disks when booting on GNU/Linux-libre.
|
||||
|
||||
*** (guix profiles) provides a representation of package transactions
|
||||
|
||||
This factorizes code between ‘guix package’ and the Emacs user interface.
|
||||
|
||||
*** Bootstrapping packages moved to (gnu packages commencement) modules
|
||||
|
||||
** Bugs fixed
|
||||
|
||||
*** ‘guix-daemon’ now really deduplicates store items by default
|
||||
|
||||
Deduplication means that identical files found in /gnu/store are stored only
|
||||
once, using hard links. This feature was wrongfully disabled, and is now
|
||||
enabled by default. The former ‘--disable-store-optimization’ option has been
|
||||
renamed to ‘--disable-deduplication’.
|
||||
|
||||
*** ‘guix-daemon’ no longer uses ‘vfork’
|
||||
|
||||
This could cause problems with ancient Linux kernel.
|
||||
|
||||
*** Fixed compilation of ‘gccgo’ (<http://bugs.gnu.org/18101>)
|
||||
*** 'make clean' doesn't delete os-config.tmpl (<http://bugs.gnu.org/18243>)
|
||||
*** Fix handling of periods by fill-paragraph (<http://bugs.gnu.org/17468>)
|
||||
*** Produce a top-level Info 'dir' file (<http://bugs.gnu.org/18305>)
|
||||
*** guix offload ignores unreachable machines (<http://bugs.gnu.org/18070>)
|
||||
*** guix offload: Ignore EEXIST when registering a .drv as a GC root
|
||||
(<http://bugs.gnu.org/18115>)
|
||||
*** perl-tk: Build sequentially (<http://bugs.gnu.org/18262>)
|
||||
*** download: Use the 'SERVER NAME' TLS extension when possible
|
||||
(<http://bugs.gnu.org/18526>)
|
||||
*** libdaemon: Add alternate source URLs (<http://bugs.gnu.org/18639>)
|
||||
*** icu4c: Reinstate RUNPATH on shared libraries
|
||||
(<http://bugs.gnu.org/18695>)
|
||||
*** nss-mdns: Add alternate source URLs (<http://bugs.gnu.org/18704>)
|
||||
*** download: Add "Accept: */*" to the HTTP headers
|
||||
(<http://bugs.gnu.org/18768>)
|
||||
*** guix-register: Do not attempt to create NIX_STORE_DIR
|
||||
(<http://bugs.gnu.org/18689>)
|
||||
*** Allow Linux-libre to find our 'modprobe' command
|
||||
(<http://bugs.gnu.org/18525>)
|
||||
*** man-pages: Build sequentially (<http://bugs.gnu.org/18701>)
|
||||
*** Fix intermittent test failures involving GC (<http://bugs.gnu.org/18935>)
|
||||
*** guix import: pypi: Gracefully handle non-existent packages
|
||||
(<http://bugs.gnu.org/18831>)
|
||||
*** Make sure the shared library has the '.so' extension
|
||||
(<http://bugs.gnu.org/18521>)
|
||||
*** pull: Use the build procedure provided by the newly-downloaded Guix.
|
||||
(<http://bugs.gnu.org/18534>)
|
||||
*** WindowMaker no longer pollutes $PATH (<http://bugs.gnu.org/18698>)
|
||||
|
||||
** Native language support
|
||||
*** New translation: cs (Czech)
|
||||
*** Updated translations: de, sr, vi
|
||||
|
||||
* Changes in 0.7 (since 0.6)
|
||||
** Package management
|
||||
*** Binaries for mips64el-linux now available from hydra.gnu.org
|
||||
|
||||
@@ -22,6 +22,10 @@ GNU Guix currently depends on the following packages:
|
||||
|
||||
- [[http://gnu.org/software/guile/][GNU Guile 2.0.x]], version 2.0.5 or later
|
||||
- [[http://gnupg.org/][GNU libgcrypt]]
|
||||
- optionally [[http://savannah.nongnu.org/projects/guile-json/][Guile-JSON]], for the 'guix import pypi' command
|
||||
- optionally [[http://www.gnutls.org][GnuTLS]] compiled with guile support enabled, for HTTPS support
|
||||
in the 'guix download' command. Note that 'guix import pypi' requires
|
||||
this functionality.
|
||||
|
||||
Unless `--disable-daemon' was passed, the following packages are needed:
|
||||
|
||||
@@ -52,25 +56,29 @@ To do so:
|
||||
- Install the dependencies (see 'Requirements' above) and build tools using
|
||||
Guix:
|
||||
|
||||
guix package --install={autoconf,automake,bzip2,gcc-toolchain,gettext,guile,libgcrypt,pkg-config,sqlite}
|
||||
guix package --install autoconf automake bzip2 gcc-toolchain gettext \
|
||||
guile libgcrypt pkg-config sqlite
|
||||
|
||||
- set the environment variables that Guix recommends you to set during the
|
||||
- Set the environment variables that Guix recommends you to set during the
|
||||
package installation process:
|
||||
ACLOCAL_PATH, CPATH, LIBRARY_PATH, PKG_CONFIG_PATH
|
||||
|
||||
- set the PATH environment variable to refer to the profile:
|
||||
- Set the PATH environment variable to refer to the profile:
|
||||
PATH=$HOME/.guix-profile/bin:$PATH
|
||||
|
||||
- re-run the configure script passing it the option
|
||||
`--with-libgcrypt-prefix=$HOME/.guix-profile/'
|
||||
- Re-run the 'configure' script passing it the option
|
||||
'--with-libgcrypt-prefix=$HOME/.guix-profile/', as well as
|
||||
'--localstatedir=/somewhere', where '/somewhere' is the 'localstatedir'
|
||||
value of the currently installed Guix (failing to do that would lead the
|
||||
new Guix to consider the store to be empty!).
|
||||
|
||||
- run "make" and "make install"
|
||||
- Run "make", "make check", and "make install".
|
||||
|
||||
* How It Works
|
||||
|
||||
Guix does the high-level preparation of a /derivation/. A derivation is
|
||||
the promise of a build; it is stored as a text file under
|
||||
=/nix/store/xxx.drv=. The (guix derivations) module provides the
|
||||
=/gnu/store/xxx.drv=. The (guix derivations) module provides the
|
||||
`derivation' primitive, as well as higher-level wrappers such as
|
||||
`build-expression->derivation'.
|
||||
|
||||
|
||||
@@ -7,8 +7,9 @@ suggestions, bug reports, patches, internationalization, or general
|
||||
infrastructure help:
|
||||
|
||||
Lluís Batlle i Rossell <viric@viric.name>
|
||||
Taylan Ulrich Bayirli/Kammer <taylanbayirli@gmail.com>
|
||||
Federico Beffa <beffa@ieee.org>
|
||||
Marek Benc <merkur32@gmail.com>
|
||||
Sylvain Beucler <beuc@beuc.net>
|
||||
Carlos Carleos <carleos@uniovi.es>
|
||||
Felipe Castro <fefcas@gmail.com>
|
||||
Daniel Clark <dclark@pobox.com>
|
||||
@@ -17,6 +18,7 @@ infrastructure help:
|
||||
John Darrington <jmd@gnu.org>
|
||||
Rafael Ferreira <rafael.f.f1@gmail.com>
|
||||
Christian Grothoff <christian@grothoff.org>
|
||||
Brandon Invergo <brandon@gnu.org>
|
||||
Jeffrin Jose <ahiliation@yahoo.co.in>
|
||||
Kete <kete@ninthfloor.org>
|
||||
Alex Kost <alezost@gmail.com>
|
||||
@@ -24,8 +26,15 @@ infrastructure help:
|
||||
Niels Möller <nisse@lysator.liu.se>
|
||||
Yutaka Niibe <gniibe@fsij.org>
|
||||
Adam Pribyl <pribyl@lowlevel.cz>
|
||||
Bruno Félix Rezende Ribeiro <oitofelix@gnu.org>
|
||||
Cyrill Schenkel <cyrill.schenkel@gmail.com>
|
||||
Benno Schulenberg <coordinator@translationproject.org>
|
||||
Jason Self <jself@gnu.org>
|
||||
Alen Skondro <askondro@gmail.com>
|
||||
Matthias Wachs <wachs@net.in.tum.de>
|
||||
Philip Woods <elzairthesorcerer@gmail.com>
|
||||
|
||||
GNU Guix also includes non-software works. Thanks to the following
|
||||
people who contributed the logo and general artwork and themes:
|
||||
|
||||
Nikita Karetnikov <nikita@karetnikov.org>
|
||||
Felipe López <felipe.lopez@openmailbox.org>
|
||||
|
||||
@@ -3,26 +3,12 @@
|
||||
#+TITLE: What's left to do?
|
||||
#+STARTUP: content hidestars
|
||||
|
||||
Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
|
||||
Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
||||
|
||||
Copying and distribution of this file, with or without modification,
|
||||
are permitted in any medium without royalty provided the copyright
|
||||
notice and this notice are preserved.
|
||||
|
||||
* integrate needed Nix code
|
||||
|
||||
** MAYBE Add a substituter that uses the GNUnet DHT or [[http://libswift.org][libswift]]
|
||||
|
||||
Would be neat if binaries could be pushed to and pulled from the GNUnet DHT or
|
||||
rather libswift (since DHTs aren’t suited for large payloads). Guix users
|
||||
would sign their binaries, and define which binaries they trust.
|
||||
|
||||
Use UPnP and similar to traverse NAT, like ‘filegive’ does.
|
||||
|
||||
** Add a remote build hook
|
||||
|
||||
Like scripts/build-remote.pl in Nix.
|
||||
|
||||
* Add `guix publish' to publish the store using Guile's web server
|
||||
|
||||
Generate narinfos and nars on the fly, upon HTTP GET requests.
|
||||
@@ -30,16 +16,18 @@ Ideally, extend .nix-cache-info to include the server's public key, and also
|
||||
reply to requests for .narinfo.sig.
|
||||
Optionally, use Guile-Avahi to publish the service.
|
||||
|
||||
* MAYBE Add a substituter that uses the GNUnet DHT or [[http://libswift.org][libswift]]
|
||||
|
||||
Would be neat if binaries could be pushed to and pulled from the GNUnet DHT or
|
||||
rather libswift (since DHTs aren’t suited for large payloads). Guix users
|
||||
would sign their binaries, and define which binaries they trust.
|
||||
|
||||
Use UPnP and similar to traverse NAT, like ‘filegive’ does.
|
||||
|
||||
* user interface
|
||||
** Add a package.el (Emacs) back-end
|
||||
|
||||
package.el is quite monolithic, but we may be able to reuse/extend
|
||||
‘package-menu-mode’ or at least ‘tabulated-list-mode’.
|
||||
|
||||
** add guile-ncurses interface
|
||||
|
||||
* extend <package>
|
||||
|
||||
** add ‘recommends’ field
|
||||
|
||||
For instance, glibc, binutils, gcc, and ld-wrapper would recommend each other.
|
||||
@@ -76,15 +64,10 @@ The Guildhall is Guile’s packaging system. It should be easy to add a
|
||||
‘guildhall-build-system’ that does the right thing based on guildhall
|
||||
recipes.
|
||||
|
||||
* add ‘allowed-references’ in <package>
|
||||
|
||||
[[file:~/src/nix/src/libstore/build.cc::if%20(drv.env.find("allowedReferences")%20!%3D%20drv.env.end())%20{][See how Nix implements that internally]].
|
||||
|
||||
* union
|
||||
|
||||
Support sophisticated collision handling when building a union: check
|
||||
whether the colliding files are identical, honor per-package priorities,
|
||||
etc.
|
||||
Support sophisticated collision handling when building a union: honor
|
||||
per-package priorities, etc.
|
||||
|
||||
* add GUIX_ALLOW_EXPENSIVE_TESTS
|
||||
|
||||
@@ -96,7 +79,6 @@ run when that is defined.
|
||||
Would download a substitute, and compare its contents against a (hopefully
|
||||
locally-built) copy.
|
||||
|
||||
|
||||
* guix build utils
|
||||
** MAYBE Change ‘ld-wrapper’ to add RPATH for libs passed by file name
|
||||
|
||||
@@ -107,13 +89,9 @@ locally-built) copy.
|
||||
See [[https://github.com/NixOS/nixpkgs/commit/d1662d715514e6ef9d3dc29f132f1b3d8e608a18][Shea Levy's `replace-dependency' in Nixpkgs]].
|
||||
|
||||
* distro
|
||||
** port to new GNU/Linux platforms, notably ‘mipsel64-linux’
|
||||
** port to GNU/Hurd, aka. ‘i686-gnu’
|
||||
|
||||
Problems include that current glibc releases do not build on GNU/Hurd.
|
||||
In addition, there haven’t been stable releases of GNU Mach, MiG, and
|
||||
Hurd, which would be a pre-condition.
|
||||
|
||||
** make a bootable GNU/Linux-Libre distro, with OS configuration EDSL
|
||||
|
||||
Similar in spirit to /etc/nixos/configuration.nix.
|
||||
|
||||
@@ -0,0 +1,98 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2014 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/>.
|
||||
|
||||
(define-module (build-self)
|
||||
#:use-module (gnu)
|
||||
#:use-module (guix)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:export (build))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
;;; When loaded, this module returns a monadic procedure of at least one
|
||||
;;; argument: the source tree to build. It returns a derivation that
|
||||
;;; builds it.
|
||||
;;;
|
||||
;;; This file uses modules provided by the already-installed Guix. Those
|
||||
;;; modules may be arbitrarily old compared to the version we want to
|
||||
;;; build. Because of that, it must rely on the smallest set of features
|
||||
;;; that are likely to be provided by the (guix) and (gnu) modules, and by
|
||||
;;; Guile itself, forever and ever.
|
||||
;;;
|
||||
;;; Code:
|
||||
|
||||
|
||||
;; The dependencies. Don't refer explicitly to the variables because they
|
||||
;; could be renamed or shuffled around in modules over time. Conversely,
|
||||
;; 'find-best-packages-by-name' is expected to always have the same semantics.
|
||||
|
||||
(define libgcrypt
|
||||
(first (find-best-packages-by-name "libgcrypt" #f)))
|
||||
|
||||
(define guile-json
|
||||
(first (find-best-packages-by-name "guile-json" #f)))
|
||||
|
||||
|
||||
|
||||
;; The actual build procedure.
|
||||
|
||||
(define (top-source-directory)
|
||||
"Return the name of the top-level directory of this source tree."
|
||||
(and=> (assoc-ref (current-source-location) 'filename)
|
||||
(lambda (file)
|
||||
(string-append (dirname file) "/.."))))
|
||||
|
||||
;; The procedure below is our return value.
|
||||
(define* (build source #:key verbose?
|
||||
#:allow-other-keys
|
||||
#:rest rest)
|
||||
"Return a derivation that unpacks SOURCE into STORE and compiles Scheme
|
||||
files."
|
||||
(define builder
|
||||
#~(begin
|
||||
(use-modules (guix build pull))
|
||||
|
||||
(let ((json (string-append #$guile-json "/share/guile/site/2.0")))
|
||||
(set! %load-path (cons json %load-path))
|
||||
(set! %load-compiled-path (cons json %load-compiled-path)))
|
||||
|
||||
(build-guix #$output #$source
|
||||
|
||||
;; XXX: This is not perfect, enabling VERBOSE? means
|
||||
;; building a different derivation.
|
||||
#:debug-port (if #$verbose?
|
||||
(current-error-port)
|
||||
(%make-void-port "w"))
|
||||
#:gcrypt #$libgcrypt)))
|
||||
|
||||
(gexp->derivation "guix-latest" builder
|
||||
#:modules '((guix build pull)
|
||||
(guix build utils))
|
||||
|
||||
;; Arrange so that our own (guix build …) modules are
|
||||
;; used.
|
||||
#:module-path (list (top-source-directory))))
|
||||
|
||||
;; This file is loaded by 'guix pull'; return it the build procedure.
|
||||
build
|
||||
|
||||
;; Local Variables:
|
||||
;; eval: (put 'with-load-path 'scheme-indent-function 1)
|
||||
;; End:
|
||||
|
||||
;;; build-self.scm ends here
|
||||
@@ -24,7 +24,7 @@
|
||||
(guix packages)
|
||||
(guix derivations)
|
||||
(guix ui)
|
||||
(gnu packages base)
|
||||
(gnu packages commencement)
|
||||
(ice-9 match)
|
||||
(srfi srfi-1)
|
||||
(srfi srfi-26))
|
||||
|
||||
@@ -53,6 +53,7 @@
|
||||
(gnu packages compression)
|
||||
(gnu packages multiprecision)
|
||||
(gnu packages make-bootstrap)
|
||||
(gnu packages commencement)
|
||||
(gnu system)
|
||||
(gnu system vm)
|
||||
(gnu system install)
|
||||
@@ -150,24 +151,45 @@ system.")
|
||||
(run-with-store store
|
||||
(system-disk-image installation-os
|
||||
#:disk-image-size
|
||||
(* 630 MiB)))))
|
||||
(* 800 MiB)))))
|
||||
'()))
|
||||
|
||||
(define job-name
|
||||
;; Return the name of a package's job.
|
||||
(compose string->symbol package-full-name))
|
||||
|
||||
(define package->job
|
||||
(let ((base-packages
|
||||
(delete-duplicates
|
||||
(append-map (match-lambda
|
||||
((_ package _ ...)
|
||||
(match (package-transitive-inputs package)
|
||||
(((_ inputs _ ...) ...)
|
||||
inputs))))
|
||||
%final-inputs))))
|
||||
(lambda (store package system)
|
||||
"Return a job for PACKAGE on SYSTEM, or #f if this combination is not
|
||||
valid."
|
||||
(cond ((member package base-packages)
|
||||
#f)
|
||||
((member system
|
||||
(package-transitive-supported-systems package))
|
||||
(package-job store (job-name package) package system))
|
||||
(else
|
||||
#f)))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Hydra entry point.
|
||||
;;;
|
||||
|
||||
(define (hydra-jobs store arguments)
|
||||
"Return Hydra jobs."
|
||||
(define systems
|
||||
;; Systems we want to build for.
|
||||
'("x86_64-linux" "i686-linux"
|
||||
"mips64el-linux"))
|
||||
|
||||
(define subset
|
||||
(match (assoc-ref arguments 'subset)
|
||||
("core" 'core) ; only build core packages
|
||||
(_ 'all))) ; build everything
|
||||
|
||||
(define job-name
|
||||
(compose string->symbol package-full-name))
|
||||
|
||||
(define (cross-jobs system)
|
||||
(define (from-32-to-64? target)
|
||||
;; Return true if SYSTEM is 32-bit and TARGET is 64-bit.
|
||||
@@ -194,33 +216,25 @@ system.")
|
||||
(remove (either from-32-to-64? same?) %cross-targets)))
|
||||
|
||||
;; Return one job for each package, except bootstrap packages.
|
||||
(let ((base-packages (delete-duplicates
|
||||
(append-map (match-lambda
|
||||
((_ package _ ...)
|
||||
(match (package-transitive-inputs
|
||||
package)
|
||||
(((_ inputs _ ...) ...)
|
||||
inputs))))
|
||||
%final-inputs))))
|
||||
(append-map (lambda (system)
|
||||
(case subset
|
||||
((all)
|
||||
;; Build everything.
|
||||
(fold-packages (lambda (package result)
|
||||
(if (member package base-packages)
|
||||
result
|
||||
(cons (package-job store (job-name package)
|
||||
package system)
|
||||
result)))
|
||||
(append (qemu-jobs store system)
|
||||
(cross-jobs system))))
|
||||
((core)
|
||||
;; Build core packages only.
|
||||
(append (map (lambda (package)
|
||||
(package-job store (job-name package)
|
||||
package system))
|
||||
%core-packages)
|
||||
(cross-jobs system)))
|
||||
(else
|
||||
(error "unknown subset" subset))))
|
||||
systems)))
|
||||
(append-map (lambda (system)
|
||||
(case subset
|
||||
((all)
|
||||
;; Build everything.
|
||||
(fold-packages (lambda (package result)
|
||||
(let ((job (package->job store package
|
||||
system)))
|
||||
(if job
|
||||
(cons job result)
|
||||
result)))
|
||||
(append (qemu-jobs store system)
|
||||
(cross-jobs system))))
|
||||
((core)
|
||||
;; Build core packages only.
|
||||
(append (map (lambda (package)
|
||||
(package-job store (job-name package)
|
||||
package system))
|
||||
%core-packages)
|
||||
(cross-jobs system)))
|
||||
(else
|
||||
(error "unknown subset" subset))))
|
||||
%supported-systems))
|
||||
|
||||
@@ -100,10 +100,25 @@ decreasing, is 1."
|
||||
(->sxml (package-license package)))
|
||||
|
||||
(define (patches package)
|
||||
(define (patch-url patch)
|
||||
(string-append
|
||||
"http://git.savannah.gnu.org/cgit/guix.git/tree/gnu/packages/patches/"
|
||||
(basename patch)))
|
||||
(define patch-url
|
||||
(match-lambda
|
||||
((? string? patch)
|
||||
(string-append
|
||||
"http://git.savannah.gnu.org/cgit/guix.git/tree/gnu/packages/patches/"
|
||||
(basename patch)))
|
||||
((? origin? patch)
|
||||
(match (origin-uri patch)
|
||||
((? string? uri) uri)
|
||||
((head . tail) head)))))
|
||||
|
||||
(define patch-name
|
||||
(match-lambda
|
||||
((? string? patch)
|
||||
(basename patch))
|
||||
((? origin? patch)
|
||||
(match (origin-uri patch)
|
||||
((? string? uri) (basename uri))
|
||||
((head . tail) (basename head))))))
|
||||
|
||||
(define (snippet-link snippet)
|
||||
(let ((loc (or (package-field-location package 'source)
|
||||
@@ -134,7 +149,7 @@ decreasing, is 1."
|
||||
(cons `(a (@ (href ,(patch-url patch))
|
||||
(title ,(string-append
|
||||
"Link to "
|
||||
(basename patch))))
|
||||
(patch-name patch))))
|
||||
,(number->string number))
|
||||
links))))))))))
|
||||
|
||||
@@ -147,9 +162,8 @@ decreasing, is 1."
|
||||
,system))
|
||||
|
||||
`(div "status: "
|
||||
,(url "x86_64-linux") " "
|
||||
,(url "i686-linux") " "
|
||||
,(url "mips64el-linux")))
|
||||
,(list-join (map url (package-transitive-supported-systems package))
|
||||
" ")))
|
||||
|
||||
(define (package-logo name)
|
||||
(and=> (lookup-gnu-package name)
|
||||
|
||||
@@ -47,6 +47,16 @@
|
||||
result))
|
||||
'())))
|
||||
|
||||
(define (escape-quotes str)
|
||||
"Replace any quote character in STR by an escaped quote character."
|
||||
(list->string
|
||||
(string-fold-right (lambda (chr result)
|
||||
(match chr
|
||||
(#\" (cons* #\\ #\"result))
|
||||
(_ (cons chr result))))
|
||||
'()
|
||||
str)))
|
||||
|
||||
;; Iterate over GNU packages. Report those whose synopsis defers from that
|
||||
;; found upstream.
|
||||
(for-each (match-lambda
|
||||
@@ -69,7 +79,7 @@
|
||||
(not (string=? (fill-paragraph upstream 100)
|
||||
(fill-paragraph downstream 100))))
|
||||
(format (guix-warning-port)
|
||||
"~a: ~a: proposed description:~% ~a~%"
|
||||
"~a: ~a: proposed description:~% \"~a\"~%"
|
||||
(location->string loc) (package-name package)
|
||||
(fill-paragraph upstream 77 7))))))
|
||||
(fill-paragraph (escape-quotes upstream) 77 7))))))
|
||||
gnus)
|
||||
|
||||
+4
-1
@@ -78,10 +78,13 @@ if test "x$guix_build_daemon" = "xyes"; then
|
||||
dnl lutimes and lchown: used when canonicalizing store items.
|
||||
dnl posix_fallocate: used when extracting archives.
|
||||
dnl vfork: to speed up spawning of helper programs.
|
||||
dnl `--> now disabled because of unpredictable behavior:
|
||||
dnl see <http://lists.gnu.org/archive/html/guix-devel/2014-05/msg00036.html>
|
||||
dnl and Nix commit f794465c (Nov. 2012).
|
||||
dnl sched_setaffinity: to improve RPC locality.
|
||||
dnl statvfs: to detect disk-full conditions.
|
||||
dnl strsignal: for error reporting.
|
||||
AC_CHECK_FUNCS([lutimes lchown posix_fallocate vfork sched_setaffinity \
|
||||
AC_CHECK_FUNCS([lutimes lchown posix_fallocate sched_setaffinity \
|
||||
statvfs nanosleep strsignal])
|
||||
|
||||
dnl Check whether the store optimiser can optimise symlinks.
|
||||
|
||||
+14
-1
@@ -2,7 +2,7 @@
|
||||
# Process this file with autoconf to produce a configure script.
|
||||
|
||||
AC_PREREQ(2.68)
|
||||
AC_INIT([GNU Guix], [0.7], [bug-guix@gnu.org], [guix],
|
||||
AC_INIT([GNU Guix], [0.8], [bug-guix@gnu.org], [guix],
|
||||
[http://www.gnu.org/software/guix/])
|
||||
AC_CONFIG_AUX_DIR([build-aux])
|
||||
|
||||
@@ -61,6 +61,10 @@ if test "x$GUILD" = "x"; then
|
||||
AC_MSG_ERROR(['guild' binary not found; please check your guile-2.x installation.])
|
||||
fi
|
||||
|
||||
dnl guile-json is used for the PyPI package importer
|
||||
GUILE_MODULE_AVAILABLE([have_guile_json], [(json)])
|
||||
AM_CONDITIONAL([HAVE_GUILE_JSON], [test "x$have_guile_json" = "xyes"])
|
||||
|
||||
dnl Make sure we have a full-fledged Guile.
|
||||
GUIX_ASSERT_GUILE_FEATURES([regex posix socket net-db threads])
|
||||
|
||||
@@ -174,4 +178,13 @@ AC_CONFIG_FILES([scripts/guix], [chmod +x scripts/guix])
|
||||
AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env])
|
||||
AC_CONFIG_FILES([test-env], [chmod +x test-env])
|
||||
|
||||
dnl Emacs interface.
|
||||
AM_PATH_LISPDIR
|
||||
AM_CONDITIONAL([HAVE_EMACS], [test "x$EMACS" != "xno"])
|
||||
|
||||
emacsuidir="${guilemoduledir}/guix/emacs"
|
||||
AC_SUBST([emacsuidir])
|
||||
AC_CONFIG_FILES([emacs/guix-init.el
|
||||
emacs/guix-helper.scm])
|
||||
|
||||
AC_OUTPUT
|
||||
|
||||
@@ -19,6 +19,7 @@
|
||||
|
||||
info_TEXINFOS = doc/guix.texi
|
||||
EXTRA_DIST += \
|
||||
doc/emacs.texi \
|
||||
doc/fdl-1.3.texi \
|
||||
doc/images/bootstrap-graph.dot \
|
||||
doc/images/bootstrap-graph.eps \
|
||||
|
||||
+472
@@ -0,0 +1,472 @@
|
||||
@node Emacs Interface
|
||||
@section Emacs Interface
|
||||
|
||||
@cindex Emacs
|
||||
GNU Guix comes with a visual user interface for GNU@tie{}Emacs, known
|
||||
as ``guix.el''. It can be used for routine package management tasks,
|
||||
pretty much like the @command{guix package} command (@pxref{Invoking
|
||||
guix package}). Specifically, ``guix.el'' makes it easy to:
|
||||
|
||||
@itemize
|
||||
@item browse and display packages and generations;
|
||||
@item search, install, upgrade and remove packages;
|
||||
@item display packages from previous generations;
|
||||
@item do some other useful things.
|
||||
@end itemize
|
||||
|
||||
@menu
|
||||
* Initial Setup: Emacs Initial Setup. Preparing @file{~/.emacs}.
|
||||
* Usage: Emacs Usage. Using the interface.
|
||||
* Configuration: Emacs Configuration. Configuring the interface.
|
||||
* Prettify Mode: Emacs Prettify. Abbreviating @file{/gnu/store/@dots{}} file names.
|
||||
@end menu
|
||||
|
||||
@node Emacs Initial Setup
|
||||
@subsection Initial Setup
|
||||
|
||||
To be able to use ``guix.el'', you need to install the following
|
||||
packages:
|
||||
|
||||
@itemize
|
||||
@item
|
||||
@uref{http://www.gnu.org/software/emacs/, GNU Emacs}, version 24.3 or
|
||||
later;
|
||||
|
||||
@item
|
||||
@uref{http://nongnu.org/geiser/, Geiser}, version 0.3 or later: it is
|
||||
used for interacting with the Guile process.
|
||||
|
||||
@end itemize
|
||||
|
||||
When it is done, add the following into your init file (@pxref{Init
|
||||
File,,, emacs, The GNU Emacs Manual}):
|
||||
|
||||
@example
|
||||
(require 'guix-init nil t)
|
||||
@end example
|
||||
|
||||
However there is a chance that @code{load-path} of your Emacs does not
|
||||
contain a directory with ``guix.el'' (usually it is
|
||||
@file{/usr/share/emacs/site-lisp/}). In that case you need to add it
|
||||
before requiring (@pxref{Lisp Libraries,,, emacs, The GNU Emacs
|
||||
Manual}):
|
||||
|
||||
@example
|
||||
(add-to-list 'load-path "/path/to/directory-with-guix.el")
|
||||
(require 'guix-init)
|
||||
@end example
|
||||
|
||||
Do not worry about the efficiency of that @code{require} thing. It will
|
||||
not load the whole ``guix.el'' package, it will just autoload the main
|
||||
interactive commands (@pxref{Autoload,,, elisp, The GNU Emacs Lisp
|
||||
Reference Manual}).
|
||||
|
||||
|
||||
@node Emacs Usage
|
||||
@subsection Usage
|
||||
|
||||
Once ``guix.el'' has been successfully configured, you should be able to
|
||||
use commands for displaying packages and generations. This information
|
||||
can be displayed in a ``list'' or ``info'' buffer.
|
||||
|
||||
@menu
|
||||
* Commands: Emacs Commands. @kbd{M-x guix-@dots{}}
|
||||
* General information: Emacs General info. Common for both interfaces.
|
||||
* ``List'' buffer: Emacs List buffer. List-like interface.
|
||||
* ``Info'' buffer: Emacs Info buffer. Help-like interface.
|
||||
@end menu
|
||||
|
||||
@node Emacs Commands
|
||||
@subsubsection Commands
|
||||
|
||||
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
|
||||
Display all installed packages.
|
||||
|
||||
@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-search-by-name
|
||||
Display package(s) with the specified name.
|
||||
|
||||
@item M-x guix-search-by-regexp
|
||||
Search for packages by a specified regexp. By default ``name'',
|
||||
``synopsis'' and ``description'' of the packages will be searched. This
|
||||
can be changed by modifying @code{guix-search-params} variable.
|
||||
|
||||
@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
|
||||
|
||||
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 restared. This
|
||||
allows you to keep using the Emacs interface with the updated Guix.
|
||||
|
||||
@node Emacs General info
|
||||
@subsubsection General information
|
||||
|
||||
The following keys are available for both ``list'' and ``info'' types of
|
||||
buffers:
|
||||
|
||||
@table @kbd
|
||||
@item l
|
||||
@itemx r
|
||||
Go backward/forward by the history of the displayed results (this
|
||||
history is similar to the history of the Emacs @code{help-mode} or
|
||||
@code{Info-mode}).
|
||||
|
||||
@item g
|
||||
Revert current buffer: update information about the displayed
|
||||
packages/generations and redisplay it.
|
||||
|
||||
@item R
|
||||
Redisplay current buffer (without updating information).
|
||||
|
||||
@item C-c C-z
|
||||
Go to the Guix REPL (@pxref{The REPL,,, geiser, Geiser User Manual}).
|
||||
|
||||
@item h
|
||||
@itemx ?
|
||||
Describe current mode to see all available bindings.
|
||||
|
||||
@end table
|
||||
|
||||
@emph{Hint:} If you need several ``list'' or ``info'' buffers, you can
|
||||
simlpy @kbd{M-x clone-buffer} them, and each buffer will have its own
|
||||
history.
|
||||
|
||||
@emph{Warning:} Name/version pairs cannot be used to identify packages
|
||||
(because a name is not necessarily unique), so ``guix.el'' uses special
|
||||
identifiers that live only during a guile session, so if the Guix REPL
|
||||
was restarted, you may want to revert ``list'' buffer (by pressing
|
||||
@kbd{g}).
|
||||
|
||||
@node Emacs List buffer
|
||||
@subsubsection ``List'' buffer
|
||||
|
||||
An interface of a ``list'' buffer is similar to the interface provided
|
||||
by ``package.el'' (@pxref{Package Menu,,, emacs, The GNU Emacs Manual}).
|
||||
|
||||
Default key bindings available for both ``package-list'' and
|
||||
``generation-list'' buffers:
|
||||
|
||||
@table @kbd
|
||||
@item m
|
||||
Mark the current entry.
|
||||
@item M
|
||||
Mark all entries.
|
||||
@item u
|
||||
Unmark the current entry (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 x
|
||||
Execute actions on the marked packages.
|
||||
@end table
|
||||
|
||||
A ``generation-list'' buffer additionally provides the following
|
||||
bindings:
|
||||
|
||||
@table @kbd
|
||||
@item @key{RET}
|
||||
List packages installed in the current generation.
|
||||
@item i
|
||||
Describe marked generations (display available information in a
|
||||
``generation-info'' buffer).
|
||||
@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
|
||||
@subsubsection ``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 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
|
||||
Has the same meaning as @code{--no-substitutes} option (@pxref{Invoking
|
||||
guix build}).
|
||||
|
||||
@item guix-dry-run
|
||||
Has the same meaning as @code{--dry-run} option (@pxref{Invoking guix
|
||||
build}).
|
||||
|
||||
@end table
|
||||
|
||||
@node Emacs 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-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
|
||||
guix-buffer-name-function #'guix-buffer-name-simple))
|
||||
@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-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:
|
||||
|
||||
@table @code
|
||||
@item guix-list-column-format
|
||||
@itemx guix-list-column-titles
|
||||
@itemx guix-list-column-value-methods
|
||||
Specify the columns, their names, what and how is displayed in ``list''
|
||||
buffers.
|
||||
|
||||
@item guix-info-displayed-params
|
||||
@itemx guix-info-insert-methods
|
||||
@itemx guix-info-ignore-empty-vals
|
||||
@itemx guix-info-param-title-format
|
||||
@itemx guix-info-multiline-prefix
|
||||
@itemx guix-info-indent
|
||||
@itemx guix-info-fill-column
|
||||
@itemx guix-info-delimiter
|
||||
Various settings for ``info'' buffers.
|
||||
|
||||
@end table
|
||||
|
||||
|
||||
@node Emacs Prettify
|
||||
@subsection Guix Prettify Mode
|
||||
|
||||
Along with ``guix.el'', GNU@tie{}Guix 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
|
||||
+985
-80
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,49 @@
|
||||
# GNU Guix --- Functional package management for GNU
|
||||
# Copyright © 2014 Alex Kost <alezost@gmail.com>
|
||||
#
|
||||
# This file is part of GNU Guix.
|
||||
#
|
||||
# GNU Guix is free software; you can redistribute it and/or modify it
|
||||
# under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 3 of the License, or (at
|
||||
# your option) any later version.
|
||||
#
|
||||
# GNU Guix is distributed in the hope that it will be useful, but
|
||||
# WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
AUTOLOADS = emacs/guix-autoloads.el
|
||||
|
||||
ELFILES = \
|
||||
emacs/guix-backend.el \
|
||||
emacs/guix-base.el \
|
||||
emacs/guix-history.el \
|
||||
emacs/guix-info.el \
|
||||
emacs/guix-list.el \
|
||||
emacs/guix-messages.el \
|
||||
emacs/guix-prettify.el \
|
||||
emacs/guix-utils.el \
|
||||
emacs/guix.el
|
||||
|
||||
if HAVE_EMACS
|
||||
|
||||
dist_lisp_DATA = \
|
||||
$(ELFILES) \
|
||||
$(AUTOLOADS)
|
||||
|
||||
nodist_lisp_DATA = \
|
||||
emacs/guix-init.el
|
||||
|
||||
$(AUTOLOADS): $(ELFILES)
|
||||
$(EMACS) --batch --eval \
|
||||
"(let ((backup-inhibited t) \
|
||||
(generated-autoload-file \
|
||||
(expand-file-name \"$(AUTOLOADS)\" \"$(srcdir)\"))) \
|
||||
(update-directory-autoloads \
|
||||
(expand-file-name \"emacs\" \"$(srcdir)\")))"
|
||||
|
||||
endif HAVE_EMACS
|
||||
@@ -0,0 +1,375 @@
|
||||
;;; guix-backend.el --- Communication with Geiser
|
||||
|
||||
;; Copyright © 2014 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides the code for interacting with Guile using Geiser.
|
||||
|
||||
;; By default (if `guix-use-guile-server' is non-nil) 2 Geiser REPLs are
|
||||
;; started. The main one (with "guile --listen" process) is used for
|
||||
;; "interacting" with a user - for showing a progress of
|
||||
;; installing/deleting Guix packages. The second (internal) REPL is
|
||||
;; used for synchronous evaluating, e.g. when information about
|
||||
;; packages/generations should be received for a list/info buffer.
|
||||
;;
|
||||
;; This "2 REPLs concept" makes it possible to have a running process of
|
||||
;; installing/deleting packages and to continue to search/list/get info
|
||||
;; about other packages at the same time. If you prefer to use a single
|
||||
;; Guix REPL, do not try to receive any information while there is a
|
||||
;; running code in the REPL (see
|
||||
;; <https://github.com/jaor/geiser/issues/28>).
|
||||
;;
|
||||
;; If you need to use "guix.el" in another Emacs (i.e. when there is
|
||||
;; a runnig "guile --listen..." REPL somewhere), you can either change
|
||||
;; `guix-default-port' in that Emacs instance or set
|
||||
;; `guix-use-guile-server' to t.
|
||||
;;
|
||||
;; Guix REPLs (unlike the usual Geiser REPLs) are not added to
|
||||
;; `geiser-repl--repls' variable, and thus cannot be used for evaluating
|
||||
;; while editing scm-files. The only purpose of Guix REPLs is to be an
|
||||
;; intermediate between "Guix/Guile level" and "Emacs interface level".
|
||||
;; That being said you can still want to use a Guix REPL while hacking
|
||||
;; auxiliary scheme-files for "guix.el". You can just use "M-x
|
||||
;; connect-to-guile" (connect to "localhost" and `guix-default-port') to
|
||||
;; have a usual Geiser REPL with all stuff defined by "guix.el" package.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'geiser-mode)
|
||||
|
||||
(defvar guix-load-path
|
||||
(file-name-directory (or load-file-name
|
||||
(locate-library "guix")))
|
||||
"Directory with scheme files for \"guix.el\" package.")
|
||||
|
||||
(defvar guix-helper-file
|
||||
(expand-file-name "guix-helper.scm" guix-load-path)
|
||||
"Auxiliary scheme file for loading.")
|
||||
|
||||
(defvar guix-guile-program (or geiser-guile-binary "guile")
|
||||
"Name of the guile executable used for Guix REPL.
|
||||
May be either a string (the name of the executable) or a list of
|
||||
strings of the form:
|
||||
|
||||
(NAME . ARGS)
|
||||
|
||||
Where ARGS is a list of arguments to the guile program.")
|
||||
|
||||
|
||||
;;; REPL
|
||||
|
||||
(defgroup guix-repl nil
|
||||
"Settings for Guix REPLs."
|
||||
:prefix "guix-repl-"
|
||||
:group 'guix)
|
||||
|
||||
(defcustom guix-repl-startup-time 30000
|
||||
"Time, in milliseconds, to wait for Guix REPL to startup.
|
||||
Same as `geiser-repl-startup-time' but is used for Guix REPL.
|
||||
If you have a slow system, try to increase this time."
|
||||
:type 'integer
|
||||
:group 'guix-repl)
|
||||
|
||||
(defcustom guix-repl-buffer-name "*Guix REPL*"
|
||||
"Default name of a Geiser REPL buffer used for Guix."
|
||||
:type 'string
|
||||
:group 'guix-repl)
|
||||
|
||||
(defcustom guix-after-start-repl-hook ()
|
||||
"Hook called after Guix REPL is started."
|
||||
:type 'hook
|
||||
:group 'guix-repl)
|
||||
|
||||
(defcustom guix-use-guile-server t
|
||||
"If non-nil, start guile with '--listen' argument.
|
||||
This allows to receive information about packages using an additional
|
||||
REPL while some packages are being installed/removed in the main REPL."
|
||||
:type 'boolean
|
||||
:group 'guix-repl)
|
||||
|
||||
(defcustom guix-default-port 37246
|
||||
"Default port used if `guix-use-guile-server' is non-nil."
|
||||
:type 'integer
|
||||
:group 'guix-repl)
|
||||
|
||||
(defvar guix-repl-buffer nil
|
||||
"Main Geiser REPL buffer used for communicating with Guix.
|
||||
This REPL is used for processing package actions and for
|
||||
receiving information if `guix-use-guile-server' is nil.")
|
||||
|
||||
(defvar guix-internal-repl-buffer nil
|
||||
"Additional Geiser REPL buffer used for communicating with Guix.
|
||||
This REPL is used for receiving information only if
|
||||
`guix-use-guile-server' is non-nil.")
|
||||
|
||||
(defvar guix-internal-repl-buffer-name "*Guix Internal REPL*"
|
||||
"Default name of an internal Guix REPL buffer.")
|
||||
|
||||
(defvar guix-before-repl-operation-hook nil
|
||||
"Hook run before executing an operation in Guix REPL.")
|
||||
|
||||
(defvar guix-after-repl-operation-hook
|
||||
'(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-operation-success-message ()
|
||||
"Message telling about successful Guix operation."
|
||||
(message "Guix operation has been performed."))
|
||||
|
||||
(defun guix-get-guile-program (&optional internal)
|
||||
"Return a value suitable for `geiser-guile-binary'."
|
||||
(if (or internal
|
||||
(not guix-use-guile-server))
|
||||
guix-guile-program
|
||||
(append (if (listp guix-guile-program)
|
||||
guix-guile-program
|
||||
(list guix-guile-program))
|
||||
;; Guile understands "--listen=..." but not "--listen ..."
|
||||
(list (concat "--listen="
|
||||
(number-to-string guix-default-port))))))
|
||||
|
||||
(defun guix-start-process-maybe (&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)
|
||||
(let ((geiser-guile-binary (guix-get-guile-program internal))
|
||||
(geiser-guile-init-file (or internal guix-helper-file))
|
||||
(repl (get-buffer-create
|
||||
(guix-get-repl-buffer-name internal))))
|
||||
(condition-case err
|
||||
(guix-start-repl repl
|
||||
(and internal
|
||||
(geiser-repl--read-address
|
||||
"localhost" guix-default-port)))
|
||||
(text-read-only
|
||||
(error (concat "Couldn't start Guix REPL. Perhaps the port %s is busy.\n"
|
||||
"See buffer '%s' for details")
|
||||
guix-default-port (buffer-name repl))))
|
||||
(set repl-var repl)
|
||||
(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 (list guix-load-path))
|
||||
(geiser-repl-startup-time guix-repl-startup-time))
|
||||
(with-current-buffer buffer
|
||||
(geiser-repl-mode)
|
||||
(geiser-impl--set-buffer-implementation impl)
|
||||
(geiser-repl--autodoc-mode -1)
|
||||
(goto-char (point-max))
|
||||
(let ((prompt (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)))
|
||||
|
||||
|
||||
;;; Evaluating expressions
|
||||
|
||||
(defvar guix-operation-buffer nil
|
||||
"Buffer from which the latest Guix operation was performed.")
|
||||
|
||||
(defun guix-make-guile-expression (fun &rest args)
|
||||
"Return string containing a guile expression for calling FUN with ARGS."
|
||||
(format "(%S %s)" fun
|
||||
(mapconcat
|
||||
(lambda (arg)
|
||||
(cond
|
||||
((null arg) "'()")
|
||||
((or (eq arg t)
|
||||
;; An ugly hack to separate 'false' from nil
|
||||
(equal arg 'f)
|
||||
(keywordp arg))
|
||||
(concat "#" (prin1-to-string arg t)))
|
||||
((or (symbolp arg) (listp arg))
|
||||
(concat "'" (prin1-to-string arg)))
|
||||
(t (prin1-to-string arg))))
|
||||
args
|
||||
" ")))
|
||||
|
||||
(defun guix-eval (str &optional wrap)
|
||||
"Evaluate guile expression STR.
|
||||
If WRAP is non-nil, wrap STR into (begin ...) form.
|
||||
Return a list of strings with result values of evaluation."
|
||||
(with-current-buffer (guix-get-repl-buffer 'internal)
|
||||
(let* ((wrapped (if wrap (geiser-debug--wrap-region str) str))
|
||||
(code `(:eval (:scm ,wrapped)))
|
||||
(ret (geiser-eval--send/wait code)))
|
||||
(if (geiser-eval--retort-error ret)
|
||||
(error "Error in evaluating guile expression: %s"
|
||||
(geiser-eval--retort-output ret))
|
||||
(cdr (assq 'result ret))))))
|
||||
|
||||
(defun guix-eval-read (str &optional wrap)
|
||||
"Evaluate guile expression STR.
|
||||
For the meaning of WRAP, see `guix-eval'.
|
||||
Return elisp expression of the first result value of evaluation."
|
||||
;; Parsing scheme code with elisp `read' is probably not the best idea.
|
||||
(read (replace-regexp-in-string
|
||||
"#f\\|#<unspecified>" "nil"
|
||||
(replace-regexp-in-string
|
||||
"#t" "t" (car (guix-eval str wrap))))))
|
||||
|
||||
(defun guix-eval-in-repl (str &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)
|
||||
(let ((repl (guix-get-repl-buffer)))
|
||||
(with-current-buffer repl
|
||||
(geiser-repl--send str))
|
||||
(geiser-repl--switch-to-buffer repl)))
|
||||
|
||||
(provide 'guix-backend)
|
||||
|
||||
;;; guix-backend.el ends here
|
||||
+1106
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,64 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
||||
;;; under the terms of the GNU General Public License as published by
|
||||
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||
;;; your option) any later version.
|
||||
;;;
|
||||
;;; GNU Guix is distributed in the hope that it will be useful, but
|
||||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;;; GNU General Public License for more details.
|
||||
;;;
|
||||
;;; You should have received a copy of the GNU General Public License
|
||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This is an auxiliary file for the Emacs UI. It is used to add Guix
|
||||
;; directories to path variables and to load the main code.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(use-modules (ice-9 regex)
|
||||
(srfi srfi-26))
|
||||
|
||||
(define %guix-dir)
|
||||
|
||||
;; The code is taken from ‘guix’ executable script
|
||||
(define (set-paths!)
|
||||
(define-syntax-rule (push! elt v) (set! v (cons elt v)))
|
||||
|
||||
(define config-lookup
|
||||
(let ((config '(("prefix" . "@prefix@")
|
||||
("guilemoduledir" . "@guilemoduledir@")))
|
||||
(var-ref-regexp (make-regexp "\\$\\{([a-z]+)\\}")))
|
||||
(define (expand-var-ref match)
|
||||
(lookup (match:substring match 1)))
|
||||
(define (expand str)
|
||||
(regexp-substitute/global #f var-ref-regexp str
|
||||
'pre expand-var-ref 'post))
|
||||
(define (lookup name)
|
||||
(expand (assoc-ref config name)))
|
||||
lookup))
|
||||
|
||||
(let ((module-dir (config-lookup "guilemoduledir"))
|
||||
(updates-dir (and=> (or (getenv "XDG_CONFIG_HOME")
|
||||
(and=> (getenv "HOME")
|
||||
(cut string-append <> "/.config")))
|
||||
(cut string-append <> "/guix/latest"))))
|
||||
(push! module-dir %load-compiled-path)
|
||||
(if (and updates-dir (file-exists? updates-dir))
|
||||
(begin
|
||||
(set! %guix-dir updates-dir)
|
||||
(push! updates-dir %load-path)
|
||||
(push! updates-dir %load-compiled-path))
|
||||
(set! %guix-dir module-dir))))
|
||||
|
||||
(set-paths!)
|
||||
|
||||
(load-from-path "guix-main")
|
||||
|
||||
@@ -0,0 +1,92 @@
|
||||
;;; guix-history.el --- History of buffer information
|
||||
|
||||
;; Copyright © 2014 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides support for history of buffers similar to the
|
||||
;; history of a `help-mode' buffer.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-macs)
|
||||
|
||||
(defvar-local guix-history-stack-item nil
|
||||
"Current item of the history.
|
||||
A list of the form (FUNCTION [ARGS ...]).
|
||||
The item is used by calling (apply FUNCTION ARGS).")
|
||||
(put 'guix-history-stack-item 'permanent-local t)
|
||||
|
||||
(defvar-local guix-history-back-stack nil
|
||||
"Stack (list) of visited items.
|
||||
Each element of the list has a form of `guix-history-stack-item'.")
|
||||
(put 'guix-history-back-stack 'permanent-local t)
|
||||
|
||||
(defvar-local guix-history-forward-stack nil
|
||||
"Stack (list) of items visited with `guix-history-back'.
|
||||
Each element of the list has a form of `guix-history-stack-item'.")
|
||||
(put 'guix-history-forward-stack 'permanent-local t)
|
||||
|
||||
(defvar guix-history-size 0
|
||||
"Maximum number of items saved in history.
|
||||
If 0, the history is disabled.")
|
||||
|
||||
(defun guix-history-add (item)
|
||||
"Add ITEM to history."
|
||||
(and guix-history-stack-item
|
||||
(push guix-history-stack-item guix-history-back-stack))
|
||||
(setq guix-history-forward-stack nil
|
||||
guix-history-stack-item item)
|
||||
(when (>= (length guix-history-back-stack)
|
||||
guix-history-size)
|
||||
(setq guix-history-back-stack
|
||||
(cl-loop for elt in guix-history-back-stack
|
||||
for i from 1 to guix-history-size
|
||||
collect elt))))
|
||||
|
||||
(defun guix-history-replace (item)
|
||||
"Replace current item in history with ITEM."
|
||||
(setq guix-history-stack-item item))
|
||||
|
||||
(defun guix-history-goto (item)
|
||||
"Go to the ITEM of history.
|
||||
ITEM should have the form of `guix-history-stack-item'."
|
||||
(or (listp item)
|
||||
(error "Wrong value of history element"))
|
||||
(setq guix-history-stack-item item)
|
||||
(apply (car item) (cdr item)))
|
||||
|
||||
(defun guix-history-back ()
|
||||
"Go back to the previous element of history in the current buffer."
|
||||
(interactive)
|
||||
(or guix-history-back-stack
|
||||
(user-error "No previous element in history"))
|
||||
(push guix-history-stack-item guix-history-forward-stack)
|
||||
(guix-history-goto (pop guix-history-back-stack)))
|
||||
|
||||
(defun guix-history-forward ()
|
||||
"Go forward to the next element of history in the current buffer."
|
||||
(interactive)
|
||||
(or guix-history-forward-stack
|
||||
(user-error "No next element in history"))
|
||||
(push guix-history-stack-item guix-history-back-stack)
|
||||
(guix-history-goto (pop guix-history-forward-stack)))
|
||||
|
||||
(provide 'guix-history)
|
||||
|
||||
;;; guix-history.el ends here
|
||||
@@ -0,0 +1,870 @@
|
||||
;;; guix-info.el --- Info buffers for displaying entries -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright © 2014 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides a help-like buffer for displaying information
|
||||
;; about Guix packages and generations.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'guix-base)
|
||||
(require 'guix-utils)
|
||||
|
||||
(defgroup guix-info nil
|
||||
"General settings for info buffers."
|
||||
:prefix "guix-info-"
|
||||
:group 'guix)
|
||||
|
||||
(defface guix-info-param-title
|
||||
'((t :inherit font-lock-type-face))
|
||||
"Face used for titles of parameters."
|
||||
:group 'guix-info)
|
||||
|
||||
(defface guix-info-file-path
|
||||
'((t :inherit link))
|
||||
"Face used for file paths."
|
||||
:group 'guix-info)
|
||||
|
||||
(defface guix-info-url
|
||||
'((t :inherit link))
|
||||
"Face used for URLs."
|
||||
:group 'guix-info)
|
||||
|
||||
(defface guix-info-time
|
||||
'((t :inherit font-lock-constant-face))
|
||||
"Face used for timestamps."
|
||||
:group 'guix-info)
|
||||
|
||||
(defface guix-info-action-button
|
||||
'((((type x w32 ns) (class color))
|
||||
:box (:line-width 2 :style released-button)
|
||||
:background "lightgrey" :foreground "black")
|
||||
(t :inherit button))
|
||||
"Face used for action buttons."
|
||||
:group 'guix-info)
|
||||
|
||||
(defface guix-info-action-button-mouse
|
||||
'((((type x w32 ns) (class color))
|
||||
:box (:line-width 2 :style released-button)
|
||||
:background "grey90" :foreground "black")
|
||||
(t :inherit highlight))
|
||||
"Mouse face used for action buttons."
|
||||
:group 'guix-info)
|
||||
|
||||
(defcustom guix-info-ignore-empty-vals nil
|
||||
"If non-nil, do not display parameters with nil values."
|
||||
:type 'boolean
|
||||
:group 'guix-info)
|
||||
|
||||
(defvar guix-info-param-title-format "%-18s: "
|
||||
"String used to format a title of a parameter.
|
||||
It should be a '%s'-sequence. After inserting a title formatted
|
||||
with this string, a value of the parameter is inserted.
|
||||
This string is used by `guix-info-insert-title-default'.")
|
||||
|
||||
(defvar guix-info-multiline-prefix (make-string 20 ?\s)
|
||||
"String used to format multi-line parameter values.
|
||||
If a value occupies more than one line, this string is inserted
|
||||
in the beginning of each line after the first one.
|
||||
This string is used by `guix-info-insert-val-default'.")
|
||||
|
||||
(defvar guix-info-indent 2
|
||||
"Number of spaces used to indent various parts of inserted text.")
|
||||
|
||||
(defvar guix-info-fill-column 60
|
||||
"Column used for filling (word wrapping) parameters with long lines.
|
||||
If a value is not multi-line and it occupies more than this
|
||||
number of characters, it will be split into several lines.")
|
||||
|
||||
(defvar guix-info-delimiter "\n\f\n"
|
||||
"String used to separate entries.")
|
||||
|
||||
(defvar guix-info-insert-methods
|
||||
'((package
|
||||
(name guix-package-info-name)
|
||||
(version guix-package-info-version)
|
||||
(license guix-package-info-license)
|
||||
(synopsis guix-package-info-synopsis)
|
||||
(description guix-package-info-insert-description
|
||||
guix-info-insert-title-simple)
|
||||
(outputs guix-package-info-insert-outputs
|
||||
guix-info-insert-title-simple)
|
||||
(source guix-package-info-insert-source
|
||||
guix-info-insert-title-simple)
|
||||
(home-url guix-info-insert-url)
|
||||
(inputs guix-package-info-insert-inputs)
|
||||
(native-inputs guix-package-info-insert-native-inputs)
|
||||
(propagated-inputs guix-package-info-insert-propagated-inputs)
|
||||
(location guix-package-info-insert-location))
|
||||
(installed
|
||||
(path guix-package-info-insert-output-path
|
||||
guix-info-insert-title-simple)
|
||||
(dependencies guix-package-info-insert-output-dependencies
|
||||
guix-info-insert-title-simple))
|
||||
(output
|
||||
(name guix-package-info-name)
|
||||
(version guix-output-info-insert-version)
|
||||
(output guix-output-info-insert-output)
|
||||
(source guix-package-info-insert-source
|
||||
guix-info-insert-title-simple)
|
||||
(path guix-package-info-insert-output-path
|
||||
guix-info-insert-title-simple)
|
||||
(dependencies guix-package-info-insert-output-dependencies
|
||||
guix-info-insert-title-simple)
|
||||
(license guix-package-info-license)
|
||||
(synopsis guix-package-info-synopsis)
|
||||
(description guix-package-info-insert-description
|
||||
guix-info-insert-title-simple)
|
||||
(home-url guix-info-insert-url)
|
||||
(inputs guix-package-info-insert-inputs)
|
||||
(native-inputs guix-package-info-insert-native-inputs)
|
||||
(propagated-inputs guix-package-info-insert-propagated-inputs)
|
||||
(location guix-package-info-insert-location))
|
||||
(generation
|
||||
(number guix-generation-info-insert-number)
|
||||
(current guix-generation-info-insert-current)
|
||||
(path guix-info-insert-file-path)
|
||||
(time guix-info-insert-time)))
|
||||
"Methods for inserting parameter values.
|
||||
Each element of the list should have a form:
|
||||
|
||||
(ENTRY-TYPE . ((PARAM INSERT-VALUE [INSERT-TITLE]) ...))
|
||||
|
||||
INSERT-VALUE may be either nil, a face name or a function. If it
|
||||
is nil or a face, `guix-info-insert-val-default' function is
|
||||
called with parameter value and INSERT-VALUE as arguments. If it
|
||||
is a function, this function is called with parameter value and
|
||||
entry info (alist of parameters and their values) as arguments.
|
||||
|
||||
INSERT-TITLE may be either nil, a face name or a function. If it
|
||||
is nil or a face, `guix-info-insert-title-default' function is
|
||||
called with parameter title and INSERT-TITLE as arguments. If it
|
||||
is a function, this function is called with parameter title as
|
||||
argument.")
|
||||
|
||||
(defvar guix-info-displayed-params
|
||||
'((package name version synopsis outputs source location home-url
|
||||
license inputs native-inputs propagated-inputs description)
|
||||
(output name version output synopsis source path dependencies location
|
||||
home-url license inputs native-inputs propagated-inputs
|
||||
description)
|
||||
(installed path dependencies)
|
||||
(generation number prev-number current time path))
|
||||
"List of displayed entry parameters.
|
||||
Each element of the list should have a form:
|
||||
|
||||
(ENTRY-TYPE . (PARAM ...))
|
||||
|
||||
The order of displayed parameters is the same as in this list.")
|
||||
|
||||
(defun guix-info-get-insert-methods (entry-type param)
|
||||
"Return list of insert methods for parameter PARAM of ENTRY-TYPE.
|
||||
See `guix-info-insert-methods' for details."
|
||||
(guix-get-key-val guix-info-insert-methods
|
||||
entry-type param))
|
||||
|
||||
(defun guix-info-get-displayed-params (entry-type)
|
||||
"Return parameters of ENTRY-TYPE that should be displayed."
|
||||
(guix-get-key-val guix-info-displayed-params
|
||||
entry-type))
|
||||
|
||||
(defun guix-info-get-indent (&optional level)
|
||||
"Return `guix-info-indent' \"multiplied\" by LEVEL spaces.
|
||||
LEVEL is 1 by default."
|
||||
(make-string (* guix-info-indent (or level 1)) ?\s))
|
||||
|
||||
(defun guix-info-insert-indent (&optional level)
|
||||
"Insert `guix-info-indent' spaces LEVEL times (1 by default)."
|
||||
(insert (guix-info-get-indent level)))
|
||||
|
||||
(defun guix-info-insert-entries (entries entry-type)
|
||||
"Display ENTRIES of ENTRY-TYPE in the current info buffer.
|
||||
ENTRIES should have a form of `guix-entries'."
|
||||
(guix-mapinsert (lambda (entry)
|
||||
(guix-info-insert-entry entry entry-type))
|
||||
entries
|
||||
guix-info-delimiter))
|
||||
|
||||
(defun guix-info-insert-entry-default (entry entry-type
|
||||
&optional indent-level)
|
||||
"Insert ENTRY of ENTRY-TYPE into the current info buffer.
|
||||
If INDENT-LEVEL is non-nil, indent displayed information by this
|
||||
number of `guix-info-indent' spaces."
|
||||
(let ((region-beg (point)))
|
||||
(mapc (lambda (param)
|
||||
(guix-info-insert-param param entry entry-type))
|
||||
(guix-info-get-displayed-params entry-type))
|
||||
(when indent-level
|
||||
(indent-rigidly region-beg (point)
|
||||
(* indent-level guix-info-indent)))))
|
||||
|
||||
(defun guix-info-insert-entry (entry entry-type &optional indent-level)
|
||||
"Insert ENTRY of ENTRY-TYPE into the current info buffer.
|
||||
Use `guix-info-insert-ENTRY-TYPE-function' or
|
||||
`guix-info-insert-entry-default' if it is nil."
|
||||
(let* ((var (intern (concat "guix-info-insert-"
|
||||
(symbol-name entry-type)
|
||||
"-function")))
|
||||
(fun (symbol-value var)))
|
||||
(if (functionp fun)
|
||||
(funcall fun entry)
|
||||
(guix-info-insert-entry-default entry entry-type indent-level))))
|
||||
|
||||
(defun guix-info-insert-param (param entry entry-type)
|
||||
"Insert title and value of a PARAM at point.
|
||||
ENTRY is alist with parameters and their values.
|
||||
ENTRY-TYPE is a type of ENTRY."
|
||||
(let ((val (guix-get-key-val entry param)))
|
||||
(unless (and guix-info-ignore-empty-vals (null val))
|
||||
(let* ((title (guix-get-param-title entry-type param))
|
||||
(insert-methods (guix-info-get-insert-methods entry-type param))
|
||||
(val-method (car insert-methods))
|
||||
(title-method (cadr insert-methods)))
|
||||
(guix-info-method-funcall title title-method
|
||||
#'guix-info-insert-title-default)
|
||||
(guix-info-method-funcall val val-method
|
||||
#'guix-info-insert-val-default
|
||||
entry)
|
||||
(insert "\n")))))
|
||||
|
||||
(defun guix-info-method-funcall (val method default-fun &rest args)
|
||||
"Call METHOD or DEFAULT-FUN.
|
||||
|
||||
If METHOD is a function and VAL is non-nil, call this
|
||||
function by applying it to VAL and ARGS.
|
||||
|
||||
If METHOD is a face, propertize inserted VAL with this face."
|
||||
(cond ((or (null method)
|
||||
(facep method))
|
||||
(funcall default-fun val method))
|
||||
((functionp method)
|
||||
(apply method val args))
|
||||
(t (error "Unknown method '%S'" method))))
|
||||
|
||||
(defun guix-info-insert-title-default (title &optional face format)
|
||||
"Insert TITLE formatted with `guix-info-param-title-format' at point."
|
||||
(guix-format-insert title
|
||||
(or face 'guix-info-param-title)
|
||||
(or format guix-info-param-title-format)))
|
||||
|
||||
(defun guix-info-insert-title-simple (title &optional face)
|
||||
"Insert TITLE at point."
|
||||
(guix-info-insert-title-default title face "%s:"))
|
||||
|
||||
(defun guix-info-insert-val-default (val &optional face)
|
||||
"Format and insert parameter value VAL at point.
|
||||
|
||||
This function is intended to be called after
|
||||
`guix-info-insert-title-default'.
|
||||
|
||||
If VAL is a one-line string longer than `guix-info-fill-column',
|
||||
split it into several short lines. See also
|
||||
`guix-info-multiline-prefix'.
|
||||
|
||||
If FACE is non-nil, propertize inserted line(s) with this FACE."
|
||||
(guix-split-insert val face
|
||||
guix-info-fill-column
|
||||
(concat "\n" guix-info-multiline-prefix)))
|
||||
|
||||
(defun guix-info-insert-val-simple (val &optional face-or-fun)
|
||||
"Format and insert parameter value VAL at point.
|
||||
|
||||
This function is intended to be called after
|
||||
`guix-info-insert-title-simple'.
|
||||
|
||||
If VAL is a one-line string longer than `guix-info-fill-column',
|
||||
split it into several short lines and indent each line with
|
||||
`guix-info-indent' spaces.
|
||||
|
||||
If FACE-OR-FUN is a face, propertize inserted line(s) with this FACE.
|
||||
|
||||
If FACE-OR-FUN is a function, call it with VAL as argument. If
|
||||
VAL is a list, call the function on each element of this list."
|
||||
(if (null val)
|
||||
(progn (guix-info-insert-indent)
|
||||
(guix-format-insert nil))
|
||||
(let ((prefix (concat "\n" (guix-info-get-indent))))
|
||||
(insert prefix)
|
||||
(if (functionp face-or-fun)
|
||||
(guix-mapinsert face-or-fun
|
||||
(if (listp val) val (list val))
|
||||
prefix)
|
||||
(guix-split-insert val face-or-fun
|
||||
guix-info-fill-column prefix)))))
|
||||
|
||||
(defun guix-info-insert-time (seconds &optional _)
|
||||
"Insert formatted time string using SECONDS at point."
|
||||
(guix-info-insert-val-default (guix-get-time-string seconds)
|
||||
'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-path
|
||||
'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))))
|
||||
|
||||
(define-button-type 'guix-package-location
|
||||
:supertype 'guix
|
||||
'face 'guix-package-info-location
|
||||
'help-echo "Find location of this package"
|
||||
'action (lambda (btn)
|
||||
(guix-find-location (button-label btn))))
|
||||
|
||||
(define-button-type 'guix-package-name
|
||||
:supertype 'guix
|
||||
'face 'guix-package-info-name-button
|
||||
'help-echo "Describe this package"
|
||||
'action (lambda (btn)
|
||||
(guix-get-show-entries guix-profile 'info guix-package-info-type
|
||||
'name (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
|
||||
(kill-new (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))
|
||||
|
||||
(defun guix-info-insert-file-path (path &optional _)
|
||||
"Make button from file PATH and insert it at point."
|
||||
(guix-insert-button path 'guix-file))
|
||||
|
||||
(defun guix-info-insert-url (url &optional _)
|
||||
"Make button from URL and insert it at point."
|
||||
(guix-insert-button url 'guix-url))
|
||||
|
||||
|
||||
(defvar guix-info-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent
|
||||
map (make-composed-keymap button-buffer-map
|
||||
special-mode-map))
|
||||
map)
|
||||
"Parent keymap for info buffers.")
|
||||
|
||||
(define-derived-mode guix-info-mode special-mode "Guix-Info"
|
||||
"Parent mode for displaying information in info buffers.")
|
||||
|
||||
|
||||
;;; Displaying packages
|
||||
|
||||
(guix-define-buffer-type info package
|
||||
:required (id installed non-unique))
|
||||
|
||||
(defface guix-package-info-heading
|
||||
'((((type tty pc) (class color)) :weight bold)
|
||||
(t :height 1.6 :weight bold :inherit variable-pitch))
|
||||
"Face for package name and version headings."
|
||||
:group 'guix-package-info)
|
||||
|
||||
(defface guix-package-info-name
|
||||
'((t :inherit font-lock-keyword-face))
|
||||
"Face used for a name of a package."
|
||||
:group 'guix-package-info)
|
||||
|
||||
(defface guix-package-info-name-button
|
||||
'((t :inherit button))
|
||||
"Face used for a full name that can be used to describe a package."
|
||||
:group 'guix-package-info)
|
||||
|
||||
(defface guix-package-info-version
|
||||
'((t :inherit font-lock-builtin-face))
|
||||
"Face used for a version of a package."
|
||||
:group 'guix-package-info)
|
||||
|
||||
(defface guix-package-info-synopsis
|
||||
'((((type tty pc) (class color)) :weight bold)
|
||||
(t :height 1.1 :weight bold :inherit variable-pitch))
|
||||
"Face used for a synopsis of a package."
|
||||
:group 'guix-package-info)
|
||||
|
||||
(defface guix-package-info-description
|
||||
'((t))
|
||||
"Face used for a description of a package."
|
||||
:group 'guix-package-info)
|
||||
|
||||
(defface guix-package-info-license
|
||||
'((t :inherit font-lock-string-face))
|
||||
"Face used for a license of a package."
|
||||
:group 'guix-package-info)
|
||||
|
||||
(defface guix-package-info-location
|
||||
'((t :inherit link))
|
||||
"Face used for a location of a package."
|
||||
:group 'guix-package-info)
|
||||
|
||||
(defface guix-package-info-installed-outputs
|
||||
'((default :weight bold)
|
||||
(((class color) (min-colors 88) (background light))
|
||||
:foreground "ForestGreen")
|
||||
(((class color) (min-colors 88) (background dark))
|
||||
:foreground "PaleGreen")
|
||||
(((class color) (min-colors 8))
|
||||
:foreground "green")
|
||||
(t :underline t))
|
||||
"Face used for installed outputs of a package."
|
||||
:group 'guix-package-info)
|
||||
|
||||
(defface guix-package-info-uninstalled-outputs
|
||||
'((t :weight bold))
|
||||
"Face used for uninstalled outputs of a package."
|
||||
:group 'guix-package-info)
|
||||
|
||||
(defface guix-package-info-obsolete
|
||||
'((t :inherit error))
|
||||
"Face used if a package is obsolete."
|
||||
:group 'guix-package-info)
|
||||
|
||||
(defvar guix-info-insert-package-function
|
||||
#'guix-package-info-insert-with-heading
|
||||
"Function used to insert a package information.
|
||||
It is called with a single argument - alist of package parameters.
|
||||
If nil, insert package in a default way.")
|
||||
|
||||
(defvar guix-package-info-heading-params '(synopsis description)
|
||||
"List of parameters displayed in a heading along with name and version.")
|
||||
|
||||
(defun guix-package-info-insert-heading (entry)
|
||||
"Insert the heading for package ENTRY.
|
||||
Show package name, version, and `guix-package-info-heading-params'."
|
||||
(guix-format-insert (concat (guix-get-key-val entry 'name) " "
|
||||
(guix-get-key-val entry 'version))
|
||||
'guix-package-info-heading)
|
||||
(insert "\n\n")
|
||||
(mapc (lambda (param)
|
||||
(let ((val (guix-get-key-val entry param))
|
||||
(face (guix-get-symbol (symbol-name param)
|
||||
'info 'package)))
|
||||
(when val
|
||||
(guix-format-insert val (and (facep face) face))
|
||||
(insert "\n\n"))))
|
||||
guix-package-info-heading-params))
|
||||
|
||||
(defun guix-package-info-insert-with-heading (entry)
|
||||
"Insert package ENTRY with its heading at point."
|
||||
(guix-package-info-insert-heading entry)
|
||||
(mapc (lambda (param)
|
||||
(unless (or (memq param '(name version))
|
||||
(memq param guix-package-info-heading-params))
|
||||
(guix-info-insert-param param entry 'package)))
|
||||
(guix-info-get-displayed-params 'package)))
|
||||
|
||||
(defun guix-package-info-insert-description (desc &optional _)
|
||||
"Insert description DESC at point."
|
||||
(guix-info-insert-val-simple desc 'guix-package-info-description))
|
||||
|
||||
(defun guix-package-info-insert-location (location &optional _)
|
||||
"Make button from file LOCATION and insert it at point."
|
||||
(guix-insert-button location 'guix-package-location))
|
||||
|
||||
(defmacro guix-package-info-define-insert-inputs (&optional type)
|
||||
"Define a face and a function for inserting package inputs.
|
||||
TYPE is a type of inputs.
|
||||
Function name is `guix-package-info-insert-TYPE-inputs'.
|
||||
Face name is `guix-package-info-TYPE-inputs'."
|
||||
(let* ((type-str (symbol-name type))
|
||||
(type-name (and type (concat type-str "-")))
|
||||
(type-desc (and type (concat type-str " ")))
|
||||
(face (intern (concat "guix-package-info-" type-name "inputs")))
|
||||
(btn (intern (concat "guix-package-" type-name "input")))
|
||||
(fun (intern (concat "guix-package-info-insert-" type-name "inputs"))))
|
||||
`(progn
|
||||
(defface ,face
|
||||
'((t :inherit guix-package-info-name-button))
|
||||
,(concat "Face used for " type-desc "inputs of a package.")
|
||||
:group 'guix-package-info)
|
||||
|
||||
(define-button-type ',btn
|
||||
:supertype 'guix-package-name
|
||||
'face ',face)
|
||||
|
||||
(defun ,fun (inputs &optional _)
|
||||
,(concat "Make buttons from " type-desc "INPUTS and insert them at point.")
|
||||
(guix-package-info-insert-full-names inputs ',btn)))))
|
||||
|
||||
(guix-package-info-define-insert-inputs)
|
||||
(guix-package-info-define-insert-inputs native)
|
||||
(guix-package-info-define-insert-inputs propagated)
|
||||
|
||||
(defun guix-package-info-insert-full-names (names button-type)
|
||||
"Make BUTTON-TYPE buttons from package NAMES and insert them at point.
|
||||
NAMES is a list of strings."
|
||||
(if names
|
||||
(guix-info-insert-val-default
|
||||
(with-temp-buffer
|
||||
(guix-mapinsert (lambda (name)
|
||||
(guix-insert-button name button-type))
|
||||
names
|
||||
guix-list-separator)
|
||||
(buffer-substring (point-min) (point-max))))
|
||||
(guix-format-insert nil)))
|
||||
|
||||
|
||||
;;; Inserting outputs and installed parameters
|
||||
|
||||
(defvar guix-package-info-output-format "%-10s"
|
||||
"String used to format output names of the packages.
|
||||
It should be a '%s'-sequence. After inserting an output name
|
||||
formatted with this string, an action button is inserted.")
|
||||
|
||||
(defvar guix-package-info-obsolete-string "(This package is obsolete)"
|
||||
"String used if a package is obsolete.")
|
||||
|
||||
(defvar guix-info-insert-installed-function nil
|
||||
"Function used to insert an installed information.
|
||||
It is called with a single argument - alist of installed
|
||||
parameters (`output', `path', `dependencies').
|
||||
If nil, insert installed info in a default way.")
|
||||
|
||||
(defun guix-package-info-insert-outputs (outputs entry)
|
||||
"Insert OUTPUTS from package ENTRY at point."
|
||||
(and (guix-get-key-val entry 'obsolete)
|
||||
(guix-package-info-insert-obsolete-text))
|
||||
(and (guix-get-key-val entry 'non-unique)
|
||||
(guix-get-key-val entry 'installed)
|
||||
(guix-package-info-insert-non-unique-text
|
||||
(guix-get-full-name entry)))
|
||||
(insert "\n")
|
||||
(mapc (lambda (output)
|
||||
(guix-package-info-insert-output output entry))
|
||||
outputs))
|
||||
|
||||
(defun guix-package-info-insert-obsolete-text ()
|
||||
"Insert a message about obsolete package at point."
|
||||
(guix-info-insert-indent)
|
||||
(guix-format-insert guix-package-info-obsolete-string
|
||||
'guix-package-info-obsolete))
|
||||
|
||||
(defun guix-package-info-insert-non-unique-text (full-name)
|
||||
"Insert a message about non-unique package with FULL-NAME at point."
|
||||
(insert "\n")
|
||||
(guix-info-insert-indent)
|
||||
(insert "Installed outputs are displayed for a non-unique ")
|
||||
(guix-insert-button full-name 'guix-package-name)
|
||||
(insert " package."))
|
||||
|
||||
(defun guix-package-info-insert-output (output entry)
|
||||
"Insert OUTPUT at point.
|
||||
Make some fancy text with buttons and additional stuff if the
|
||||
current OUTPUT is installed (if there is such output in
|
||||
`installed' parameter of a package ENTRY)."
|
||||
(let* ((installed (guix-get-key-val entry 'installed))
|
||||
(obsolete (guix-get-key-val entry 'obsolete))
|
||||
(installed-entry (cl-find-if
|
||||
(lambda (entry)
|
||||
(string= (guix-get-key-val entry 'output)
|
||||
output))
|
||||
installed))
|
||||
(action-type (if installed-entry 'delete 'install)))
|
||||
(guix-info-insert-indent)
|
||||
(guix-format-insert output
|
||||
(if installed-entry
|
||||
'guix-package-info-installed-outputs
|
||||
'guix-package-info-uninstalled-outputs)
|
||||
guix-package-info-output-format)
|
||||
(guix-package-info-insert-action-button action-type entry output)
|
||||
(when obsolete
|
||||
(guix-info-insert-indent)
|
||||
(guix-package-info-insert-action-button 'upgrade entry output))
|
||||
(insert "\n")
|
||||
(when installed-entry
|
||||
(guix-info-insert-entry installed-entry 'installed 2))))
|
||||
|
||||
(defun guix-package-info-insert-action-button (type entry output)
|
||||
"Insert button to process an action on a package OUTPUT at point.
|
||||
TYPE is one of the following symbols: `install', `delete', `upgrade'.
|
||||
ENTRY is an alist with package info."
|
||||
(let ((type-str (capitalize (symbol-name type)))
|
||||
(full-name (guix-get-full-name entry output)))
|
||||
(guix-info-insert-action-button
|
||||
type-str
|
||||
(lambda (btn)
|
||||
(guix-process-package-actions
|
||||
guix-profile
|
||||
`((,(button-get btn 'action-type) (,(button-get btn 'id)
|
||||
,(button-get btn 'output))))
|
||||
(current-buffer)))
|
||||
(concat type-str " '" full-name "'")
|
||||
'action-type type
|
||||
'id (or (guix-get-key-val entry 'package-id)
|
||||
(guix-get-key-val entry 'id))
|
||||
'output output)))
|
||||
|
||||
(defun guix-package-info-insert-output-path (path &optional _)
|
||||
"Insert PATH of the installed output."
|
||||
(guix-info-insert-val-simple path #'guix-info-insert-file-path))
|
||||
|
||||
(defalias 'guix-package-info-insert-output-dependencies
|
||||
'guix-package-info-insert-output-path)
|
||||
|
||||
|
||||
;;; Inserting a source
|
||||
|
||||
(defface guix-package-info-source
|
||||
'((t :inherit link :underline nil))
|
||||
"Face used for a source URL of a package."
|
||||
:group 'guix-package-info)
|
||||
|
||||
(defcustom guix-package-info-auto-find-source nil
|
||||
"If non-nil, find a source file after pressing a \"Show\" button.
|
||||
If nil, just display the source file path without finding."
|
||||
:type 'boolean
|
||||
:group 'guix-package-info)
|
||||
|
||||
(defcustom guix-package-info-auto-download-source t
|
||||
"If nil, do not automatically download a source file if it doesn't exist.
|
||||
After pressing a \"Show\" button, a derivation of the package
|
||||
source is calculated and a store file path is displayed. If this
|
||||
variable is non-nil and the source file does not exist in the
|
||||
store, it will be automatically downloaded (with a possible
|
||||
prompt depending on `guix-operation-confirm' variable)."
|
||||
:type 'boolean
|
||||
:group 'guix-package-info)
|
||||
|
||||
(defvar guix-package-info-download-buffer nil
|
||||
"Buffer from which a current download operation was performed.")
|
||||
|
||||
(define-button-type 'guix-package-source
|
||||
:supertype 'guix
|
||||
'face 'guix-package-info-source
|
||||
'help-echo ""
|
||||
'action (lambda (_)
|
||||
;; As a source may not be a real URL (e.g., "mirror://..."),
|
||||
;; no action is bound to a source button.
|
||||
(message "Yes, this is the source URL. What did you expect?")))
|
||||
|
||||
(defun guix-package-info-insert-source-url (url &optional _)
|
||||
"Make button from source URL and insert it at point."
|
||||
(guix-insert-button url 'guix-package-source))
|
||||
|
||||
(defun guix-package-info-show-source (entry-id package-id)
|
||||
"Show file name of a package source in the current info buffer.
|
||||
Find the file if needed (see `guix-package-info-auto-find-source').
|
||||
ENTRY-ID is an ID of the current entry (package or output).
|
||||
PACKAGE-ID is an ID of the package which source to show."
|
||||
(let* ((entry (guix-get-entry-by-id entry-id guix-entries))
|
||||
(file (guix-package-source-path package-id)))
|
||||
(or file
|
||||
(error "Couldn't define file path of the package source"))
|
||||
(let* ((new-entry (cons (cons 'source-file file)
|
||||
entry))
|
||||
(entries (cl-substitute-if
|
||||
new-entry
|
||||
(lambda (entry)
|
||||
(equal (guix-get-key-val entry 'id)
|
||||
entry-id))
|
||||
guix-entries
|
||||
:count 1)))
|
||||
(guix-redisplay-buffer :entries entries)
|
||||
(if (file-exists-p file)
|
||||
(if guix-package-info-auto-find-source
|
||||
(guix-find-file file)
|
||||
(message "The source store path is displayed."))
|
||||
(if guix-package-info-auto-download-source
|
||||
(guix-package-info-download-source package-id)
|
||||
(message "The source does not exist in the store."))))))
|
||||
|
||||
(defun guix-package-info-download-source (package-id)
|
||||
"Download a source of the package PACKAGE-ID."
|
||||
(setq guix-package-info-download-buffer (current-buffer))
|
||||
(guix-package-source-build-derivation
|
||||
package-id
|
||||
"The source does not exist in the store. Download it?"))
|
||||
|
||||
(defun guix-package-info-insert-source (source entry)
|
||||
"Insert SOURCE from package ENTRY at point.
|
||||
SOURCE is a list of URLs."
|
||||
(guix-info-insert-indent)
|
||||
(if (null source)
|
||||
(guix-format-insert nil)
|
||||
(let* ((source-file (guix-get-key-val entry 'source-file))
|
||||
(entry-id (guix-get-key-val entry 'id))
|
||||
(package-id (or (guix-get-key-val entry 'package-id)
|
||||
entry-id)))
|
||||
(if (null source-file)
|
||||
(guix-info-insert-action-button
|
||||
"Show"
|
||||
(lambda (btn)
|
||||
(guix-package-info-show-source (button-get btn 'entry-id)
|
||||
(button-get btn 'package-id)))
|
||||
"Show the source store path of the current package"
|
||||
'entry-id entry-id
|
||||
'package-id package-id)
|
||||
(unless (file-exists-p source-file)
|
||||
(guix-info-insert-action-button
|
||||
"Download"
|
||||
(lambda (btn)
|
||||
(guix-package-info-download-source
|
||||
(button-get btn 'package-id)))
|
||||
"Download the source into the store"
|
||||
'package-id package-id))
|
||||
(guix-info-insert-val-simple source-file
|
||||
#'guix-info-insert-file-path))
|
||||
(guix-info-insert-val-simple source
|
||||
#'guix-package-info-insert-source-url))))
|
||||
|
||||
(defun guix-package-info-redisplay-after-download ()
|
||||
"Redisplay an 'info' buffer after downloading the package source.
|
||||
This function is used to hide a \"Download\" button if needed."
|
||||
(when (buffer-live-p guix-package-info-download-buffer)
|
||||
(guix-redisplay-buffer :buffer guix-package-info-download-buffer)
|
||||
(setq guix-package-info-download-buffer nil)))
|
||||
|
||||
(add-hook 'guix-after-source-download-hook
|
||||
'guix-package-info-redisplay-after-download)
|
||||
|
||||
|
||||
;;; Displaying outputs
|
||||
|
||||
(guix-define-buffer-type info output
|
||||
:buffer-name "*Guix Package Info*"
|
||||
:required (id package-id installed non-unique))
|
||||
|
||||
(defvar guix-info-insert-output-function nil
|
||||
"Function used to insert an output information.
|
||||
It is called with a single argument - alist of output parameters.
|
||||
If nil, insert output in a default way.")
|
||||
|
||||
(defun guix-output-info-insert-version (version entry)
|
||||
"Insert output VERSION and obsolete text if needed at point."
|
||||
(guix-info-insert-val-default version
|
||||
'guix-package-info-version)
|
||||
(and (guix-get-key-val entry 'obsolete)
|
||||
(guix-package-info-insert-obsolete-text)))
|
||||
|
||||
(defun guix-output-info-insert-output (output entry)
|
||||
"Insert OUTPUT and action buttons at point."
|
||||
(let* ((installed (guix-get-key-val entry 'installed))
|
||||
(obsolete (guix-get-key-val entry 'obsolete))
|
||||
(action-type (if installed 'delete 'install)))
|
||||
(guix-info-insert-val-default
|
||||
output
|
||||
(if installed
|
||||
'guix-package-info-installed-outputs
|
||||
'guix-package-info-uninstalled-outputs))
|
||||
(guix-info-insert-indent)
|
||||
(guix-package-info-insert-action-button action-type entry output)
|
||||
(when obsolete
|
||||
(guix-info-insert-indent)
|
||||
(guix-package-info-insert-action-button 'upgrade entry output))))
|
||||
|
||||
|
||||
;;; Displaying generations
|
||||
|
||||
(guix-define-buffer-type info generation)
|
||||
|
||||
(defface guix-generation-info-number
|
||||
'((t :inherit font-lock-keyword-face))
|
||||
"Face used for a number of a generation."
|
||||
:group 'guix-generation-info)
|
||||
|
||||
(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)
|
||||
|
||||
(defface guix-generation-info-not-current
|
||||
'((t nil))
|
||||
"Face used if a generation is not the current one."
|
||||
:group 'guix-generation-info)
|
||||
|
||||
(defvar guix-info-insert-generation-function nil
|
||||
"Function used to insert a generation information.
|
||||
It is called with a single argument - alist of generation parameters.
|
||||
If nil, insert generation in a default way.")
|
||||
|
||||
(defun guix-generation-info-insert-number (number &optional _)
|
||||
"Insert generation NUMBER and action buttons."
|
||||
(guix-info-insert-val-default number 'guix-generation-info-number)
|
||||
(guix-info-insert-indent)
|
||||
(guix-info-insert-action-button
|
||||
"Packages"
|
||||
(lambda (btn)
|
||||
(guix-get-show-entries guix-profile 'list guix-package-list-type
|
||||
'generation (button-get btn 'number)))
|
||||
"Show installed packages for this generation"
|
||||
'number number)
|
||||
(guix-info-insert-indent)
|
||||
(guix-info-insert-action-button
|
||||
"Delete"
|
||||
(lambda (btn)
|
||||
(guix-delete-generations guix-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-val-default "Yes" 'guix-generation-info-current)
|
||||
(guix-info-insert-val-default "No" 'guix-generation-info-not-current)
|
||||
(guix-info-insert-indent)
|
||||
(guix-info-insert-action-button
|
||||
"Switch"
|
||||
(lambda (btn)
|
||||
(guix-switch-to-generation guix-profile (button-get btn 'number)
|
||||
(current-buffer)))
|
||||
"Switch to this generation (make it the current one)"
|
||||
'number (guix-get-key-val entry 'number))))
|
||||
|
||||
(provide 'guix-info)
|
||||
|
||||
;;; guix-info.el ends here
|
||||
@@ -0,0 +1,14 @@
|
||||
(require 'guix-autoloads)
|
||||
|
||||
(defvar guix-load-path
|
||||
(replace-regexp-in-string "${prefix}" "@prefix@" "@emacsuidir@")
|
||||
"Directory with scheme files for \"guix.el\" package.")
|
||||
|
||||
(defvar guix-default-profile
|
||||
(concat (or (getenv "NIX_STATE_DIR") "@guix_localstatedir@/guix")
|
||||
"/profiles/per-user/"
|
||||
(getenv "USER")
|
||||
"/guix-profile")
|
||||
"Default Guix profile.")
|
||||
|
||||
(provide 'guix-init)
|
||||
@@ -0,0 +1,865 @@
|
||||
;;; guix-list.el --- List buffers for displaying entries -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright © 2014 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; This file is part of GNU Guix.
|
||||
|
||||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Guix is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides a list-like buffer for displaying information
|
||||
;; about Guix packages and generations.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'tabulated-list)
|
||||
(require 'guix-info)
|
||||
(require 'guix-base)
|
||||
(require 'guix-utils)
|
||||
|
||||
(defgroup guix-list nil
|
||||
"General settings for list buffers."
|
||||
:prefix "guix-list-"
|
||||
:group 'guix)
|
||||
|
||||
(defface guix-list-file-path
|
||||
'((t :inherit guix-info-file-path))
|
||||
"Face used for file paths."
|
||||
:group 'guix-list)
|
||||
|
||||
(defcustom guix-list-describe-warning-count 10
|
||||
"The maximum number of entries for describing without a warning.
|
||||
If a user wants to describe more than this number of marked
|
||||
entries, he will be prompted for confirmation."
|
||||
:type 'integer
|
||||
:group 'guix-list)
|
||||
|
||||
(defvar guix-list-column-format
|
||||
`((package
|
||||
(name 20 t)
|
||||
(version 10 nil)
|
||||
(outputs 13 t)
|
||||
(installed 13 t)
|
||||
(synopsis 30 nil))
|
||||
(output
|
||||
(name 20 t)
|
||||
(version 10 nil)
|
||||
(output 9 t)
|
||||
(installed 12 t)
|
||||
(synopsis 30 nil))
|
||||
(generation
|
||||
(number 5
|
||||
,(lambda (a b) (guix-list-sort-numerically 0 a b))
|
||||
:right-align t)
|
||||
(current 10 t)
|
||||
(time 20 t)
|
||||
(path 30 t)))
|
||||
"Columns displayed in list buffers.
|
||||
Each element of the list has a form:
|
||||
|
||||
(ENTRY-TYPE . ((PARAM WIDTH SORT . PROPS) ...))
|
||||
|
||||
PARAM is the name of an entry parameter of ENTRY-TYPE. For the
|
||||
meaning of WIDTH, SORT and PROPS, see `tabulated-list-format'.")
|
||||
|
||||
(defvar guix-list-column-titles
|
||||
'((generation
|
||||
(number . "N.")))
|
||||
"Column titles for list buffers.
|
||||
Has the same structure as `guix-param-titles', but titles from
|
||||
this list have a priority.")
|
||||
|
||||
(defvar guix-list-column-value-methods
|
||||
'((package
|
||||
(name . guix-package-list-get-name)
|
||||
(synopsis . guix-list-get-one-line)
|
||||
(description . guix-list-get-one-line)
|
||||
(installed . guix-package-list-get-installed-outputs))
|
||||
(output
|
||||
(name . guix-package-list-get-name)
|
||||
(synopsis . guix-list-get-one-line)
|
||||
(description . guix-list-get-one-line))
|
||||
(generation
|
||||
(current . guix-generation-list-get-current)
|
||||
(time . guix-list-get-time)
|
||||
(path . guix-list-get-file-path)))
|
||||
"Methods for inserting parameter values in columns.
|
||||
Each element of the list has a form:
|
||||
|
||||
(ENTRY-TYPE . ((PARAM . FUN) ...))
|
||||
|
||||
PARAM is the name of an entry parameter of ENTRY-TYPE.
|
||||
|
||||
FUN is 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 argument is an entry info (alist of
|
||||
parameters and their values).")
|
||||
|
||||
(defun guix-list-get-param-title (entry-type param)
|
||||
"Return title of an ENTRY-TYPE entry parameter PARAM."
|
||||
(or (guix-get-key-val guix-list-column-titles
|
||||
entry-type param)
|
||||
(guix-get-param-title entry-type param)))
|
||||
|
||||
(defun guix-list-get-column-format (entry-type)
|
||||
"Return column format for ENTRY-TYPE."
|
||||
(guix-get-key-val guix-list-column-format entry-type))
|
||||
|
||||
(defun guix-list-get-displayed-params (entry-type)
|
||||
"Return list of parameters of ENTRY-TYPE that should be displayed."
|
||||
(mapcar #'car
|
||||
(guix-list-get-column-format entry-type)))
|
||||
|
||||
(defun guix-list-get-sort-key (entry-type param &optional invert)
|
||||
"Return suitable sort key for `tabulated-list-sort-key'.
|
||||
Define column title by ENTRY-TYPE and PARAM. If INVERT is
|
||||
non-nil, invert the sort."
|
||||
(when (memq param (guix-list-get-displayed-params entry-type))
|
||||
(cons (guix-list-get-param-title entry-type param) invert)))
|
||||
|
||||
(defun guix-list-sort-numerically (column a b)
|
||||
"Compare COLUMN of tabulated entries A and B numerically.
|
||||
It is a sort predicate 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))))
|
||||
|
||||
(defun guix-list-make-tabulated-vector (entry-type fun)
|
||||
"Call FUN on each column specification for ENTRY-TYPE.
|
||||
|
||||
FUN is called with 2 argument: parameter name and column
|
||||
specification (see `guix-list-column-format').
|
||||
|
||||
Return a vector made of values of FUN calls."
|
||||
(apply #'vector
|
||||
(mapcar (lambda (col-spec)
|
||||
(funcall fun (car col-spec) (cdr col-spec)))
|
||||
(guix-list-get-column-format entry-type))))
|
||||
|
||||
(defun guix-list-get-list-format (entry-type)
|
||||
"Return ENTRY-TYPE list specification for `tabulated-list-format'."
|
||||
(guix-list-make-tabulated-vector
|
||||
entry-type
|
||||
(lambda (param spec)
|
||||
(cons (guix-list-get-param-title entry-type param)
|
||||
spec))))
|
||||
|
||||
(defun guix-list-insert-entries (entries entry-type)
|
||||
"Display ENTRIES of ENTRY-TYPE in the current list buffer.
|
||||
ENTRIES should have a form of `guix-entries'."
|
||||
(setq tabulated-list-entries
|
||||
(guix-list-get-tabulated-entries entries entry-type))
|
||||
(tabulated-list-print))
|
||||
|
||||
(defun guix-list-get-tabulated-entries (entries entry-type)
|
||||
"Return list of values of ENTRY-TYPE for `tabulated-list-entries'.
|
||||
Values are taken from ENTRIES which should have the form of
|
||||
`guix-entries'."
|
||||
(mapcar (lambda (entry)
|
||||
(list (guix-get-key-val entry 'id)
|
||||
(guix-list-get-tabulated-entry entry entry-type)))
|
||||
entries))
|
||||
|
||||
(defun guix-list-get-tabulated-entry (entry entry-type)
|
||||
"Return array of values for `tabulated-list-entries'.
|
||||
Parameters are taken from ENTRY of ENTRY-TYPE."
|
||||
(guix-list-make-tabulated-vector
|
||||
entry-type
|
||||
(lambda (param _)
|
||||
(let ((val (guix-get-key-val entry param))
|
||||
(fun (guix-get-key-val guix-list-column-value-methods
|
||||
entry-type param)))
|
||||
(if fun
|
||||
(funcall fun val entry)
|
||||
(guix-get-string val))))))
|
||||
|
||||
(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-time-string seconds))
|
||||
|
||||
(defun guix-list-get-file-path (path &optional _)
|
||||
"Return PATH button specification for `tabulated-list-entries'."
|
||||
(list path
|
||||
'face 'guix-list-file-path
|
||||
'action (lambda (btn) (find-file (button-label btn)))
|
||||
'follow-link t
|
||||
'help-echo "Find file"))
|
||||
|
||||
(defun guix-list-current-id ()
|
||||
"Return ID of the current entry."
|
||||
(or (tabulated-list-get-id)
|
||||
(user-error "No entry here")))
|
||||
|
||||
(defun guix-list-current-entry ()
|
||||
"Return alist of the current entry info."
|
||||
(guix-get-entry-by-id (guix-list-current-id) guix-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-mark-alist'.
|
||||
ARGS is a list of additional values.")
|
||||
|
||||
(defvar guix-list-mark-alist
|
||||
'((empty . ?\s)
|
||||
(general . ?*))
|
||||
"Alist of available mark names and mark characters.")
|
||||
|
||||
(defsubst guix-list-get-mark (name)
|
||||
"Return mark character by its NAME."
|
||||
(or (guix-get-key-val guix-list-mark-alist name)
|
||||
(error "Mark '%S' not found" name)))
|
||||
|
||||
(defsubst 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-mark-alist' except the `empty' one."
|
||||
(or mark-names
|
||||
(setq mark-names
|
||||
(delq 'empty
|
||||
(mapcar #'car guix-list-mark-alist))))
|
||||
(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-mark-alist'.
|
||||
If ADVANCE is non-nil, move forward by one line after marking.
|
||||
Interactively, put a general mark and move to the next line."
|
||||
(interactive '(general t))
|
||||
(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-all (mark-name)
|
||||
"Mark all lines with MARK-NAME mark.
|
||||
MARK-NAME is a symbol from `guix-list-mark-alist'.
|
||||
Interactively, put a general mark on all lines."
|
||||
(interactive '(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-mark-alist'."
|
||||
(guix-list-for-each-line
|
||||
(lambda ()
|
||||
(let ((mark-name (car (guix-get-key-val 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))
|
||||
|
||||
|
||||
(defvar guix-list-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map tabulated-list-mode-map)
|
||||
(define-key map (kbd "RET") 'guix-list-describe)
|
||||
(define-key map (kbd "m") 'guix-list-mark)
|
||||
(define-key map (kbd "*") 'guix-list-mark)
|
||||
(define-key map (kbd "M") 'guix-list-mark-all)
|
||||
(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)
|
||||
"Parent keymap for list buffers.")
|
||||
|
||||
(define-derived-mode guix-list-mode tabulated-list-mode "Guix-List"
|
||||
"Parent mode for displaying information in list buffers."
|
||||
(setq tabulated-list-padding 2))
|
||||
|
||||
(defmacro guix-list-define-entry-type (entry-type &rest args)
|
||||
"Define common stuff for displaying ENTRY-TYPE entries in list buffers.
|
||||
|
||||
Remaining argument (ARGS) should have a form [KEYWORD VALUE] ... The
|
||||
following keywords are available:
|
||||
|
||||
- `:sort-key' - default sort key for the tabulated list buffer.
|
||||
|
||||
- `:invert-sort' - if non-nil, invert initial sort.
|
||||
|
||||
- `:marks' - default value for the defined
|
||||
`guix-ENTRY-TYPE-mark-alist' variable.
|
||||
|
||||
This macro defines the following functions:
|
||||
|
||||
- `guix-ENTRY-TYPE-mark-MARK-NAME' functions for each mark
|
||||
specified in `:marks' argument."
|
||||
(let* ((entry-type-str (symbol-name entry-type))
|
||||
(prefix (concat "guix-" entry-type-str "-list"))
|
||||
(mode-str (concat prefix "-mode"))
|
||||
(init-fun (intern (concat prefix "-mode-initialize")))
|
||||
(marks-var (intern (concat prefix "-mark-alist")))
|
||||
(marks-val nil)
|
||||
(sort-key nil)
|
||||
(invert-sort nil))
|
||||
|
||||
;; Process the keyword args.
|
||||
(while (keywordp (car args))
|
||||
(pcase (pop args)
|
||||
(`:sort-key (setq sort-key (pop args)))
|
||||
(`:invert-sort (setq invert-sort (pop args)))
|
||||
(`:marks (setq marks-val (pop args)))
|
||||
(_ (pop args))))
|
||||
|
||||
`(progn
|
||||
(defvar ,marks-var ',marks-val
|
||||
,(concat "Alist of additional marks for `" mode-str "'.\n"
|
||||
"Marks from this list are added to `guix-list-mark-alist'."))
|
||||
|
||||
,@(mapcar (lambda (mark-spec)
|
||||
(let* ((mark-name (car mark-spec))
|
||||
(mark-name-str (symbol-name mark-name)))
|
||||
`(defun ,(intern (concat prefix "-mark-" mark-name-str "-simple")) ()
|
||||
,(concat "Put '" mark-name-str "' mark and move to the next line.\n"
|
||||
"Also add the current entry to `guix-list-marked'.")
|
||||
(interactive)
|
||||
(guix-list-mark ',mark-name t))))
|
||||
marks-val)
|
||||
|
||||
(defun ,init-fun ()
|
||||
,(concat "Initial settings for `" mode-str "'.")
|
||||
,(when sort-key
|
||||
`(setq tabulated-list-sort-key
|
||||
(guix-list-get-sort-key
|
||||
',entry-type ',sort-key ,invert-sort)))
|
||||
(setq tabulated-list-format
|
||||
(guix-list-get-list-format ',entry-type))
|
||||
(setq-local guix-list-mark-alist
|
||||
(append guix-list-mark-alist ,marks-var))
|
||||
(tabulated-list-init-header)))))
|
||||
|
||||
(put 'guix-list-define-entry-type 'lisp-indent-function 'defun)
|
||||
|
||||
(defun guix-list-describe-maybe (entry-type ids)
|
||||
"Describe ENTRY-TYPE entries in info buffer using list of IDS."
|
||||
(let ((count (length ids)))
|
||||
(when (or (<= count guix-list-describe-warning-count)
|
||||
(y-or-n-p (format "Do you really want to describe %d entries? "
|
||||
count)))
|
||||
(apply #'guix-get-show-entries
|
||||
guix-profile 'info entry-type 'id ids))))
|
||||
|
||||
(defun guix-list-describe (&optional arg)
|
||||
"Describe entries marked with a general mark.
|
||||
If no entries are marked, describe the current entry.
|
||||
With prefix (if ARG is non-nil), describe entries marked with any mark."
|
||||
(interactive "P")
|
||||
(let ((ids (or (apply #'guix-list-get-marked-id-list
|
||||
(unless arg '(general)))
|
||||
(list (guix-list-current-id)))))
|
||||
(guix-list-describe-maybe guix-entry-type ids)))
|
||||
|
||||
|
||||
;;; Displaying packages
|
||||
|
||||
(guix-define-buffer-type list package)
|
||||
|
||||
(guix-list-define-entry-type package
|
||||
:sort-key name
|
||||
:marks ((install . ?I)
|
||||
(upgrade . ?U)
|
||||
(delete . ?D)))
|
||||
|
||||
(defface guix-package-list-installed
|
||||
'((t :inherit guix-package-info-installed-outputs))
|
||||
"Face used if there are installed outputs for the current package."
|
||||
:group 'guix-package-list)
|
||||
|
||||
(defface guix-package-list-obsolete
|
||||
'((t :inherit guix-package-info-obsolete))
|
||||
"Face used if a package is obsolete."
|
||||
:group 'guix-package-list)
|
||||
|
||||
(defcustom guix-package-list-generation-marking-enabled nil
|
||||
"If non-nil, allow putting marks in a list with 'generation packages'.
|
||||
|
||||
By default this is disabled, because it may be confusing. For
|
||||
example a package is installed in some generation, so a user can
|
||||
mark it for deletion in the list of packages from this
|
||||
generation, but the package may not be installed in the latest
|
||||
generation, so actually it cannot be deleted.
|
||||
|
||||
If you managed to understand the explanation above or if you
|
||||
really know what you do or if you just don't care, you can set
|
||||
this variable to t. It should not do much harm anyway (most
|
||||
likely)."
|
||||
:type 'boolean
|
||||
:group 'guix-package-list)
|
||||
|
||||
(let ((map guix-package-list-mode-map))
|
||||
(define-key map (kbd "x") 'guix-package-list-execute)
|
||||
(define-key map (kbd "i") 'guix-package-list-mark-install)
|
||||
(define-key map (kbd "d") 'guix-package-list-mark-delete)
|
||||
(define-key map (kbd "U") 'guix-package-list-mark-upgrade)
|
||||
(define-key map (kbd "^") 'guix-package-list-mark-upgrades))
|
||||
|
||||
(defun guix-package-list-get-name (name entry)
|
||||
"Return NAME of the package ENTRY.
|
||||
Colorize it with `guix-package-list-installed' or
|
||||
`guix-package-list-obsolete' if needed."
|
||||
(guix-get-string name
|
||||
(cond ((guix-get-key-val entry 'obsolete)
|
||||
'guix-package-list-obsolete)
|
||||
((guix-get-key-val entry 'installed)
|
||||
'guix-package-list-installed))))
|
||||
|
||||
(defun guix-package-list-get-installed-outputs (installed &optional _)
|
||||
"Return string with outputs from INSTALLED entries."
|
||||
(guix-get-string
|
||||
(mapcar (lambda (entry)
|
||||
(guix-get-key-val entry 'output))
|
||||
installed)))
|
||||
|
||||
(defun guix-package-list-marking-check ()
|
||||
"Signal an error if marking is disabled for the current buffer."
|
||||
(when (and (not guix-package-list-generation-marking-enabled)
|
||||
(or (derived-mode-p 'guix-package-list-mode)
|
||||
(derived-mode-p 'guix-output-list-mode))
|
||||
(eq guix-search-type 'generation))
|
||||
(error "Action marks are disabled for lists of 'generation packages'")))
|
||||
|
||||
(defun guix-package-list-mark-outputs (mark default
|
||||
&optional prompt available)
|
||||
"Mark the current package with MARK and move to the next line.
|
||||
If PROMPT is non-nil, use it to ask a user for outputs from
|
||||
AVAILABLE list, otherwise mark all DEFAULT outputs."
|
||||
(let ((outputs (if prompt
|
||||
(guix-completing-read-multiple
|
||||
prompt available nil t)
|
||||
default)))
|
||||
(apply #'guix-list-mark mark t outputs)))
|
||||
|
||||
(defun guix-package-list-mark-install (&optional arg)
|
||||
"Mark the current package for installation and move to the next line.
|
||||
With ARG, prompt for the outputs to install (several outputs may
|
||||
be separated with \",\")."
|
||||
(interactive "P")
|
||||
(guix-package-list-marking-check)
|
||||
(let* ((entry (guix-list-current-entry))
|
||||
(all (guix-get-key-val entry 'outputs))
|
||||
(installed (guix-get-installed-outputs entry))
|
||||
(available (cl-set-difference all installed :test #'string=)))
|
||||
(or available
|
||||
(user-error "This package is already installed"))
|
||||
(guix-package-list-mark-outputs
|
||||
'install '("out")
|
||||
(and arg "Output(s) to install: ")
|
||||
available)))
|
||||
|
||||
(defun guix-package-list-mark-delete (&optional arg)
|
||||
"Mark the current package for deletion and move to the next line.
|
||||
With ARG, prompt for the outputs to delete (several outputs may
|
||||
be separated with \",\")."
|
||||
(interactive "P")
|
||||
(guix-package-list-marking-check)
|
||||
(let* ((entry (guix-list-current-entry))
|
||||
(installed (guix-get-installed-outputs entry)))
|
||||
(or installed
|
||||
(user-error "This package is not installed"))
|
||||
(guix-package-list-mark-outputs
|
||||
'delete installed
|
||||
(and arg "Output(s) to delete: ")
|
||||
installed)))
|
||||
|
||||
(defun guix-package-list-mark-upgrade (&optional arg)
|
||||
"Mark the current package for upgrading and move to the next line.
|
||||
With ARG, prompt for the outputs to upgrade (several outputs may
|
||||
be separated with \",\")."
|
||||
(interactive "P")
|
||||
(guix-package-list-marking-check)
|
||||
(let* ((entry (guix-list-current-entry))
|
||||
(installed (guix-get-installed-outputs entry)))
|
||||
(or installed
|
||||
(user-error "This package is not installed"))
|
||||
(when (or (guix-get-key-val entry 'obsolete)
|
||||
(y-or-n-p "This package is not obsolete. Try to upgrade it anyway? "))
|
||||
(guix-package-list-mark-outputs
|
||||
'upgrade installed
|
||||
(and arg "Output(s) to upgrade: ")
|
||||
installed))))
|
||||
|
||||
(defun guix-list-mark-package-upgrades (fun)
|
||||
"Mark all obsolete packages for upgrading.
|
||||
Use FUN to perform marking of the current line. FUN should
|
||||
accept an entry as argument."
|
||||
(guix-package-list-marking-check)
|
||||
(let ((obsolete (cl-remove-if-not
|
||||
(lambda (entry)
|
||||
(guix-get-key-val entry 'obsolete))
|
||||
guix-entries)))
|
||||
(guix-list-for-each-line
|
||||
(lambda ()
|
||||
(let* ((id (guix-list-current-id))
|
||||
(entry (cl-find-if
|
||||
(lambda (entry)
|
||||
(equal id (guix-get-key-val entry 'id)))
|
||||
obsolete)))
|
||||
(when entry
|
||||
(funcall fun entry)))))))
|
||||
|
||||
(defun guix-package-list-mark-upgrades ()
|
||||
"Mark all obsolete packages for upgrading."
|
||||
(interactive)
|
||||
(guix-list-mark-package-upgrades
|
||||
(lambda (entry)
|
||||
(apply #'guix-list-mark
|
||||
'upgrade nil
|
||||
(guix-get-installed-outputs entry)))))
|
||||
|
||||
(defun guix-list-execute-package-actions (fun)
|
||||
"Perform actions on the marked packages.
|
||||
Use FUN to define actions suitable for `guix-process-package-actions'.
|
||||
FUN should accept action-type as argument."
|
||||
(let ((actions (delq nil
|
||||
(mapcar fun '(install delete upgrade)))))
|
||||
(if actions
|
||||
(guix-process-package-actions
|
||||
guix-profile actions (current-buffer))
|
||||
(user-error "No operations specified"))))
|
||||
|
||||
(defun guix-package-list-execute ()
|
||||
"Perform actions on the marked packages."
|
||||
(interactive)
|
||||
(guix-list-execute-package-actions #'guix-package-list-make-action))
|
||||
|
||||
(defun guix-package-list-make-action (action-type)
|
||||
"Return action specification for the packages marked with ACTION-TYPE.
|
||||
Return nil, if there are no packages marked with ACTION-TYPE.
|
||||
The specification is suitable for `guix-process-package-actions'."
|
||||
(let ((specs (guix-list-get-marked-args action-type)))
|
||||
(and specs (cons action-type specs))))
|
||||
|
||||
|
||||
;;; Displaying outputs
|
||||
|
||||
(guix-define-buffer-type list output
|
||||
:buffer-name "*Guix Package List*")
|
||||
|
||||
(guix-list-define-entry-type output
|
||||
:sort-key name
|
||||
:marks ((install . ?I)
|
||||
(upgrade . ?U)
|
||||
(delete . ?D)))
|
||||
|
||||
(let ((map guix-output-list-mode-map))
|
||||
(define-key map (kbd "RET") 'guix-output-list-describe)
|
||||
(define-key map (kbd "x") 'guix-output-list-execute)
|
||||
(define-key map (kbd "i") 'guix-output-list-mark-install)
|
||||
(define-key map (kbd "d") 'guix-output-list-mark-delete)
|
||||
(define-key map (kbd "U") 'guix-output-list-mark-upgrade)
|
||||
(define-key map (kbd "^") 'guix-output-list-mark-upgrades))
|
||||
|
||||
(defun guix-output-list-mark-install ()
|
||||
"Mark the current output for installation and move to the next line."
|
||||
(interactive)
|
||||
(guix-package-list-marking-check)
|
||||
(let* ((entry (guix-list-current-entry))
|
||||
(installed (guix-get-key-val entry 'installed)))
|
||||
(if installed
|
||||
(user-error "This output is already installed")
|
||||
(guix-list-mark 'install t))))
|
||||
|
||||
(defun guix-output-list-mark-delete ()
|
||||
"Mark the current output for deletion and move to the next line."
|
||||
(interactive)
|
||||
(guix-package-list-marking-check)
|
||||
(let* ((entry (guix-list-current-entry))
|
||||
(installed (guix-get-key-val entry 'installed)))
|
||||
(if installed
|
||||
(guix-list-mark 'delete t)
|
||||
(user-error "This output is not installed"))))
|
||||
|
||||
(defun guix-output-list-mark-upgrade ()
|
||||
"Mark the current output for deletion and move to the next line."
|
||||
(interactive)
|
||||
(guix-package-list-marking-check)
|
||||
(let* ((entry (guix-list-current-entry))
|
||||
(installed (guix-get-key-val entry 'installed)))
|
||||
(or installed
|
||||
(user-error "This output is not installed"))
|
||||
(when (or (guix-get-key-val entry 'obsolete)
|
||||
(y-or-n-p "This output is not obsolete. Try to upgrade it anyway? "))
|
||||
(guix-list-mark 'upgrade t))))
|
||||
|
||||
(defun guix-output-list-mark-upgrades ()
|
||||
"Mark all obsolete package outputs for upgrading."
|
||||
(interactive)
|
||||
(guix-list-mark-package-upgrades
|
||||
(lambda (_) (guix-list-mark 'upgrade))))
|
||||
|
||||
(defun guix-output-list-execute ()
|
||||
"Perform actions on the marked outputs."
|
||||
(interactive)
|
||||
(guix-list-execute-package-actions #'guix-output-list-make-action))
|
||||
|
||||
(defun guix-output-list-make-action (action-type)
|
||||
"Return action specification for the outputs marked with ACTION-TYPE.
|
||||
Return nil, if there are no outputs marked with ACTION-TYPE.
|
||||
The specification is suitable for `guix-process-output-actions'."
|
||||
(let ((ids (guix-list-get-marked-id-list action-type)))
|
||||
(and ids (cons action-type
|
||||
(mapcar #'guix-get-package-id-and-output-by-output-id
|
||||
ids)))))
|
||||
|
||||
(defun guix-output-list-describe (&optional arg)
|
||||
"Describe outputs or packages marked with a general mark.
|
||||
If no entries are marked, describe the current output or package.
|
||||
With prefix (if ARG is non-nil), describe entries marked with any mark.
|
||||
Also see `guix-package-info-type'."
|
||||
(interactive "P")
|
||||
(if (eq guix-package-info-type 'output)
|
||||
(guix-list-describe arg)
|
||||
(let* ((oids (or (apply #'guix-list-get-marked-id-list
|
||||
(unless arg '(general)))
|
||||
(list (guix-list-current-id))))
|
||||
(pids (mapcar (lambda (oid)
|
||||
(car (guix-get-package-id-and-output-by-output-id
|
||||
oid)))
|
||||
oids)))
|
||||
(guix-list-describe-maybe 'package (cl-remove-duplicates pids)))))
|
||||
|
||||
|
||||
;;; Displaying generations
|
||||
|
||||
(guix-define-buffer-type list generation)
|
||||
|
||||
(guix-list-define-entry-type generation
|
||||
:sort-key number
|
||||
:invert-sort 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 "i") 'guix-list-describe)
|
||||
(define-key map (kbd "s") '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-get-key-val entry 'current))
|
||||
(number (guix-get-key-val entry 'number)))
|
||||
(if current
|
||||
(user-error "This generation is already the current one")
|
||||
(guix-switch-to-generation guix-profile number (current-buffer)))))
|
||||
|
||||
(defun guix-generation-list-show-packages ()
|
||||
"List installed packages for the generation at point."
|
||||
(interactive)
|
||||
(guix-get-show-entries guix-profile 'list guix-package-list-type
|
||||
'generation (guix-list-current-id)))
|
||||
|
||||
(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-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)
|
||||
(apply #'guix-get-show-entries
|
||||
guix-profile 'list 'output 'generation-diff
|
||||
(reverse (guix-generation-list-generations-to-compare))))
|
||||
|
||||
(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)
|
||||
(apply #'guix-get-show-entries
|
||||
guix-profile 'list 'output 'generation-diff
|
||||
(guix-generation-list-generations-to-compare)))
|
||||
|
||||
(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-profile marked (current-buffer))))
|
||||
|
||||
(provide 'guix-list)
|
||||
|
||||
;;; guix-list.el ends here
|
||||
@@ -0,0 +1,918 @@
|
||||
;;; 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:
|
||||
|
||||
;; Information about packages and generations is passed to the elisp
|
||||
;; side in the form of alists of parameters (such as ‘name’ or
|
||||
;; ‘version’) and their values.
|
||||
|
||||
;; ‘entries’ procedure is the “entry point” for the elisp side to get
|
||||
;; information about packages and generations.
|
||||
|
||||
;; Since name/version pair is not necessarily unique, we use
|
||||
;; `object-address' to identify a package (for ‘id’ parameter), if
|
||||
;; possible. However for the obsolete packages (that can be found in
|
||||
;; installed manifest but not in a package directory), ‘id’ parameter is
|
||||
;; still "name-version" string. So ‘id’ package parameter in the code
|
||||
;; below is either an object-address number or a full-name string.
|
||||
|
||||
;; To speed-up the process of getting information, the following
|
||||
;; auxiliary variables are used:
|
||||
;;
|
||||
;; - `%packages' - VHash of "package address"/"package" pairs.
|
||||
;;
|
||||
;; - `%package-table' - Hash table of
|
||||
;; "name+version key"/"list of packages" pairs.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(use-modules
|
||||
(ice-9 vlist)
|
||||
(ice-9 match)
|
||||
(srfi srfi-1)
|
||||
(srfi srfi-2)
|
||||
(srfi srfi-11)
|
||||
(srfi srfi-19)
|
||||
(srfi srfi-26)
|
||||
(guix)
|
||||
(guix git-download)
|
||||
(guix packages)
|
||||
(guix profiles)
|
||||
(guix licenses)
|
||||
(guix utils)
|
||||
(guix ui)
|
||||
(guix scripts package)
|
||||
(guix scripts pull)
|
||||
(gnu packages))
|
||||
|
||||
(define-syntax-rule (first-or-false lst)
|
||||
(and (not (null? lst))
|
||||
(first lst)))
|
||||
|
||||
(define (list-maybe obj)
|
||||
(if (list? obj) obj (list obj)))
|
||||
|
||||
(define full-name->name+version package-name->name+version)
|
||||
(define (name+version->full-name name version)
|
||||
(string-append name "-" version))
|
||||
|
||||
(define* (make-package-specification name #:optional version output)
|
||||
(let ((full-name (if version
|
||||
(name+version->full-name name version)
|
||||
name)))
|
||||
(if output
|
||||
(string-append full-name ":" output)
|
||||
full-name)))
|
||||
|
||||
(define name+version->key cons)
|
||||
(define key->name+version car+cdr)
|
||||
|
||||
(define %packages
|
||||
(fold-packages (lambda (pkg res)
|
||||
(vhash-consq (object-address pkg) pkg res))
|
||||
vlist-null))
|
||||
|
||||
(define %package-table
|
||||
(let ((table (make-hash-table (vlist-length %packages))))
|
||||
(vlist-for-each
|
||||
(lambda (elem)
|
||||
(match elem
|
||||
((address . pkg)
|
||||
(let* ((key (name+version->key (package-name pkg)
|
||||
(package-version pkg)))
|
||||
(ref (hash-ref table key)))
|
||||
(hash-set! table key
|
||||
(if ref (cons pkg ref) (list pkg)))))))
|
||||
%packages)
|
||||
table))
|
||||
|
||||
(define (manifest-entry->name+version+output entry)
|
||||
(values
|
||||
(manifest-entry-name entry)
|
||||
(manifest-entry-version entry)
|
||||
(manifest-entry-output entry)))
|
||||
|
||||
(define (manifest-entry->package-specification entry)
|
||||
(call-with-values
|
||||
(lambda () (manifest-entry->name+version+output entry))
|
||||
make-package-specification))
|
||||
|
||||
(define (manifest-entries->package-specifications entries)
|
||||
(map manifest-entry->package-specification entries))
|
||||
|
||||
(define (generation-package-specifications profile number)
|
||||
"Return a list of package specifications for generation NUMBER."
|
||||
(let ((manifest (profile-manifest
|
||||
(generation-file-name profile number))))
|
||||
(manifest-entries->package-specifications
|
||||
(manifest-entries manifest))))
|
||||
|
||||
(define (generation-package-specifications+paths profile number)
|
||||
"Return a list of package specifications and paths for generation NUMBER.
|
||||
Each element of the list is a list of the package specification and its path."
|
||||
(let ((manifest (profile-manifest
|
||||
(generation-file-name profile number))))
|
||||
(map (lambda (entry)
|
||||
(list (manifest-entry->package-specification entry)
|
||||
(manifest-entry-item entry)))
|
||||
(manifest-entries manifest))))
|
||||
|
||||
(define (generation-difference profile number1 number2)
|
||||
"Return a list of package specifications for outputs installed in generation
|
||||
NUMBER1 and not installed in generation NUMBER2."
|
||||
(let ((specs1 (generation-package-specifications profile number1))
|
||||
(specs2 (generation-package-specifications profile number2)))
|
||||
(lset-difference string=? specs1 specs2)))
|
||||
|
||||
(define (manifest-entries->hash-table entries)
|
||||
"Return a hash table of name keys and lists of matching manifest ENTRIES."
|
||||
(let ((table (make-hash-table (length entries))))
|
||||
(for-each (lambda (entry)
|
||||
(let* ((key (manifest-entry-name entry))
|
||||
(ref (hash-ref table key)))
|
||||
(hash-set! table key
|
||||
(if ref (cons entry ref) (list entry)))))
|
||||
entries)
|
||||
table))
|
||||
|
||||
(define (manifest=? m1 m2)
|
||||
(or (eq? m1 m2)
|
||||
(equal? m1 m2)))
|
||||
|
||||
(define manifest->hash-table
|
||||
(let ((current-manifest #f)
|
||||
(current-table #f))
|
||||
(lambda (manifest)
|
||||
"Return a hash table of name keys and matching MANIFEST entries."
|
||||
(unless (manifest=? manifest current-manifest)
|
||||
(set! current-manifest manifest)
|
||||
(set! current-table (manifest-entries->hash-table
|
||||
(manifest-entries manifest))))
|
||||
current-table)))
|
||||
|
||||
(define* (manifest-entries-by-name manifest name #:optional version output)
|
||||
"Return a list of MANIFEST entries matching NAME, VERSION and OUTPUT."
|
||||
(let ((entries (or (hash-ref (manifest->hash-table manifest) name)
|
||||
'())))
|
||||
(if (or version output)
|
||||
(filter (lambda (entry)
|
||||
(and (or (not version)
|
||||
(equal? version (manifest-entry-version entry)))
|
||||
(or (not output)
|
||||
(equal? output (manifest-entry-output entry)))))
|
||||
entries)
|
||||
entries)))
|
||||
|
||||
(define (manifest-entry-by-output entries output)
|
||||
"Return a manifest entry from ENTRIES matching OUTPUT."
|
||||
(find (lambda (entry)
|
||||
(string= output (manifest-entry-output entry)))
|
||||
entries))
|
||||
|
||||
(define (fold-manifest-by-name manifest proc init)
|
||||
"Fold over MANIFEST entries.
|
||||
Call (PROC NAME VERSION ENTRIES RESULT), using INIT as the initial value
|
||||
of RESULT. ENTRIES is a list of manifest entries with NAME/VERSION."
|
||||
(hash-fold (lambda (name entries res)
|
||||
(proc name (manifest-entry-version (car entries))
|
||||
entries res))
|
||||
init
|
||||
(manifest->hash-table manifest)))
|
||||
|
||||
(define* (object-transformer param-alist #:optional (params '()))
|
||||
"Return procedure transforming objects into alist of parameter/value pairs.
|
||||
|
||||
PARAM-ALIST is alist of available parameters (symbols) and procedures
|
||||
returning values of these parameters. Each procedure is applied to
|
||||
objects.
|
||||
|
||||
PARAMS is list of parameters from PARAM-ALIST that should be returned by
|
||||
a resulting procedure. If PARAMS is not specified or is an empty list,
|
||||
use all available parameters.
|
||||
|
||||
Example:
|
||||
|
||||
(let* ((alist `((plus1 . ,1+) (minus1 . ,1-) (mul2 . ,(cut * 2 <>))))
|
||||
(number->alist (object-transformer alist '(plus1 mul2))))
|
||||
(number->alist 8))
|
||||
=>
|
||||
((plus1 . 9) (mul2 . 16))
|
||||
"
|
||||
(let* ((use-all-params (null? params))
|
||||
(alist (filter-map (match-lambda
|
||||
((param . proc)
|
||||
(and (or use-all-params
|
||||
(memq param params))
|
||||
(cons param proc)))
|
||||
(_ #f))
|
||||
param-alist)))
|
||||
(lambda objects
|
||||
(map (match-lambda
|
||||
((param . proc)
|
||||
(cons param (apply proc objects))))
|
||||
alist))))
|
||||
|
||||
(define %manifest-entry-param-alist
|
||||
`((output . ,manifest-entry-output)
|
||||
(path . ,manifest-entry-item)
|
||||
(dependencies . ,manifest-entry-dependencies)))
|
||||
|
||||
(define manifest-entry->sexp
|
||||
(object-transformer %manifest-entry-param-alist))
|
||||
|
||||
(define (manifest-entries->sexps entries)
|
||||
(map manifest-entry->sexp entries))
|
||||
|
||||
(define (package-inputs-names inputs)
|
||||
"Return a list of full names of the packages from package INPUTS."
|
||||
(filter-map (match-lambda
|
||||
((_ (? package? package))
|
||||
(package-full-name package))
|
||||
(_ #f))
|
||||
inputs))
|
||||
|
||||
(define (package-license-names package)
|
||||
"Return a list of license names of the PACKAGE."
|
||||
(filter-map (lambda (license)
|
||||
(and (license? license)
|
||||
(license-name license)))
|
||||
(list-maybe (package-license package))))
|
||||
|
||||
(define (package-source-names package)
|
||||
"Return a list of source names (URLs) of the PACKAGE."
|
||||
(let ((source (package-source package)))
|
||||
(and (origin? source)
|
||||
(filter-map (lambda (uri)
|
||||
(cond ((string? uri)
|
||||
uri)
|
||||
((git-reference? uri)
|
||||
(git-reference-url uri))
|
||||
(else "Unknown source type")))
|
||||
(list-maybe (origin-uri source))))))
|
||||
|
||||
(define (package-unique? package)
|
||||
"Return #t if PACKAGE is a single package with such name/version."
|
||||
(null? (cdr (packages-by-name (package-name package)
|
||||
(package-version package)))))
|
||||
|
||||
(define %package-param-alist
|
||||
`((id . ,object-address)
|
||||
(package-id . ,object-address)
|
||||
(name . ,package-name)
|
||||
(version . ,package-version)
|
||||
(license . ,package-license-names)
|
||||
(source . ,package-source-names)
|
||||
(synopsis . ,package-synopsis)
|
||||
(description . ,package-description)
|
||||
(home-url . ,package-home-page)
|
||||
(outputs . ,package-outputs)
|
||||
(non-unique . ,(negate package-unique?))
|
||||
(inputs . ,(lambda (pkg)
|
||||
(package-inputs-names
|
||||
(package-inputs pkg))))
|
||||
(native-inputs . ,(lambda (pkg)
|
||||
(package-inputs-names
|
||||
(package-native-inputs pkg))))
|
||||
(propagated-inputs . ,(lambda (pkg)
|
||||
(package-inputs-names
|
||||
(package-propagated-inputs pkg))))
|
||||
(location . ,(lambda (pkg)
|
||||
(location->string (package-location pkg))))))
|
||||
|
||||
(define (package-param package param)
|
||||
"Return a value of a PACKAGE PARAM."
|
||||
(and=> (assq-ref %package-param-alist param)
|
||||
(cut <> package)))
|
||||
|
||||
|
||||
;;; Finding packages.
|
||||
|
||||
(define (package-by-address address)
|
||||
(and=> (vhash-assq address %packages)
|
||||
cdr))
|
||||
|
||||
(define (packages-by-name+version name version)
|
||||
(or (hash-ref %package-table
|
||||
(name+version->key name version))
|
||||
'()))
|
||||
|
||||
(define (packages-by-full-name full-name)
|
||||
(call-with-values
|
||||
(lambda () (full-name->name+version full-name))
|
||||
packages-by-name+version))
|
||||
|
||||
(define (packages-by-id id)
|
||||
(if (integer? id)
|
||||
(let ((pkg (package-by-address id)))
|
||||
(if pkg (list pkg) '()))
|
||||
(packages-by-full-name id)))
|
||||
|
||||
(define (id->name+version id)
|
||||
(if (integer? id)
|
||||
(and=> (package-by-address id)
|
||||
(lambda (pkg)
|
||||
(values (package-name pkg)
|
||||
(package-version pkg))))
|
||||
(full-name->name+version id)))
|
||||
|
||||
(define (package-by-id id)
|
||||
(first-or-false (packages-by-id id)))
|
||||
|
||||
(define (newest-package-by-id id)
|
||||
(and=> (id->name+version id)
|
||||
(lambda (name)
|
||||
(first-or-false (find-best-packages-by-name name #f)))))
|
||||
|
||||
(define (matching-packages predicate)
|
||||
(fold-packages (lambda (pkg res)
|
||||
(if (predicate pkg)
|
||||
(cons pkg res)
|
||||
res))
|
||||
'()))
|
||||
|
||||
(define (filter-packages-by-output packages output)
|
||||
(filter (lambda (package)
|
||||
(member output (package-outputs package)))
|
||||
packages))
|
||||
|
||||
(define* (packages-by-name name #:optional version output)
|
||||
"Return a list of packages matching NAME, VERSION and OUTPUT."
|
||||
(let ((packages (if version
|
||||
(packages-by-name+version name version)
|
||||
(matching-packages
|
||||
(lambda (pkg) (string=? name (package-name pkg)))))))
|
||||
(if output
|
||||
(filter-packages-by-output packages output)
|
||||
packages)))
|
||||
|
||||
(define (manifest-entry->packages entry)
|
||||
(call-with-values
|
||||
(lambda () (manifest-entry->name+version+output entry))
|
||||
packages-by-name))
|
||||
|
||||
(define (packages-by-regexp regexp match-params)
|
||||
"Return a list of packages matching REGEXP string.
|
||||
MATCH-PARAMS is a list of parameters that REGEXP can match."
|
||||
(define (package-match? package regexp)
|
||||
(any (lambda (param)
|
||||
(let ((val (package-param package param)))
|
||||
(and (string? val) (regexp-exec regexp val))))
|
||||
match-params))
|
||||
|
||||
(let ((re (make-regexp regexp regexp/icase)))
|
||||
(matching-packages (cut package-match? <> re))))
|
||||
|
||||
(define (all-available-packages)
|
||||
"Return a list of all available packages."
|
||||
(matching-packages (const #t)))
|
||||
|
||||
(define (newest-available-packages)
|
||||
"Return a list of the newest available packages."
|
||||
(vhash-fold (lambda (name elem res)
|
||||
(match elem
|
||||
((_ newest pkgs ...)
|
||||
(cons newest res))))
|
||||
'()
|
||||
(find-newest-available-packages)))
|
||||
|
||||
|
||||
;;; Making package/output patterns.
|
||||
|
||||
(define (specification->package-pattern specification)
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
(full-name->name+version specification))
|
||||
list))
|
||||
|
||||
(define (specification->output-pattern specification)
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
(package-specification->name+version+output specification #f))
|
||||
list))
|
||||
|
||||
(define (id->package-pattern id)
|
||||
(if (integer? id)
|
||||
(package-by-address id)
|
||||
(specification->package-pattern id)))
|
||||
|
||||
(define (id->output-pattern id)
|
||||
"Return an output pattern by output ID.
|
||||
ID should be '<package-address>:<output>' or '<name>-<version>:<output>'."
|
||||
(let-values (((name version output)
|
||||
(package-specification->name+version+output id)))
|
||||
(if version
|
||||
(list name version output)
|
||||
(list (package-by-address (string->number name))
|
||||
output))))
|
||||
|
||||
(define (specifications->package-patterns . specifications)
|
||||
(map specification->package-pattern specifications))
|
||||
|
||||
(define (specifications->output-patterns . specifications)
|
||||
(map specification->output-pattern specifications))
|
||||
|
||||
(define (ids->package-patterns . ids)
|
||||
(map id->package-pattern ids))
|
||||
|
||||
(define (ids->output-patterns . ids)
|
||||
(map id->output-pattern ids))
|
||||
|
||||
(define* (manifest-patterns-result packages res obsolete-pattern
|
||||
#:optional installed-pattern)
|
||||
"Auxiliary procedure for 'manifest-package-patterns' and
|
||||
'manifest-output-patterns'."
|
||||
(if (null? packages)
|
||||
(cons (obsolete-pattern) res)
|
||||
(if installed-pattern
|
||||
;; We don't need duplicates for a list of installed packages,
|
||||
;; so just take any (car) package.
|
||||
(cons (installed-pattern (car packages)) res)
|
||||
res)))
|
||||
|
||||
(define* (manifest-package-patterns manifest #:optional obsolete-only?)
|
||||
"Return a list of package patterns for MANIFEST entries.
|
||||
If OBSOLETE-ONLY? is #f, use all entries, otherwise make patterns only
|
||||
for obsolete packages."
|
||||
(fold-manifest-by-name
|
||||
manifest
|
||||
(lambda (name version entries res)
|
||||
(manifest-patterns-result (packages-by-name name version)
|
||||
res
|
||||
(lambda () (list name version entries))
|
||||
(and (not obsolete-only?)
|
||||
(cut list <> entries))))
|
||||
'()))
|
||||
|
||||
(define* (manifest-output-patterns manifest #:optional obsolete-only?)
|
||||
"Return a list of output patterns for MANIFEST entries.
|
||||
If OBSOLETE-ONLY? is #f, use all entries, otherwise make patterns only
|
||||
for obsolete packages."
|
||||
(fold (lambda (entry res)
|
||||
(manifest-patterns-result (manifest-entry->packages entry)
|
||||
res
|
||||
(lambda () entry)
|
||||
(and (not obsolete-only?)
|
||||
(cut list <> entry))))
|
||||
'()
|
||||
(manifest-entries manifest)))
|
||||
|
||||
(define (obsolete-package-patterns manifest)
|
||||
(manifest-package-patterns manifest #t))
|
||||
|
||||
(define (obsolete-output-patterns manifest)
|
||||
(manifest-output-patterns manifest #t))
|
||||
|
||||
|
||||
;;; Transforming package/output patterns into alists.
|
||||
|
||||
(define (obsolete-package-sexp name version entries)
|
||||
"Return an alist with information about obsolete package.
|
||||
ENTRIES is a list of installed manifest entries."
|
||||
`((id . ,(name+version->full-name name version))
|
||||
(name . ,name)
|
||||
(version . ,version)
|
||||
(outputs . ,(map manifest-entry-output entries))
|
||||
(obsolete . #t)
|
||||
(installed . ,(manifest-entries->sexps entries))))
|
||||
|
||||
(define (package-pattern-transformer manifest params)
|
||||
"Return 'package-pattern->package-sexps' procedure."
|
||||
(define package->sexp
|
||||
(object-transformer %package-param-alist params))
|
||||
|
||||
(define* (sexp-by-package package #:optional
|
||||
(entries (manifest-entries-by-name
|
||||
manifest
|
||||
(package-name package)
|
||||
(package-version package))))
|
||||
(cons (cons 'installed (manifest-entries->sexps entries))
|
||||
(package->sexp package)))
|
||||
|
||||
(define (->sexps pattern)
|
||||
(match pattern
|
||||
((? package? package)
|
||||
(list (sexp-by-package package)))
|
||||
(((? package? package) entries)
|
||||
(list (sexp-by-package package entries)))
|
||||
((name version entries)
|
||||
(list (obsolete-package-sexp
|
||||
name version entries)))
|
||||
((name version)
|
||||
(let ((packages (packages-by-name name version)))
|
||||
(if (null? packages)
|
||||
(let ((entries (manifest-entries-by-name
|
||||
manifest name version)))
|
||||
(if (null? entries)
|
||||
'()
|
||||
(list (obsolete-package-sexp
|
||||
name version entries))))
|
||||
(map sexp-by-package packages))))
|
||||
(_ '())))
|
||||
|
||||
->sexps)
|
||||
|
||||
(define (output-pattern-transformer manifest params)
|
||||
"Return 'output-pattern->output-sexps' procedure."
|
||||
(define package->sexp
|
||||
(object-transformer (alist-delete 'id %package-param-alist)
|
||||
params))
|
||||
|
||||
(define manifest-entry->sexp
|
||||
(object-transformer (alist-delete 'output %manifest-entry-param-alist)
|
||||
params))
|
||||
|
||||
(define* (output-sexp pkg-alist pkg-address output
|
||||
#:optional entry)
|
||||
(let ((entry-alist (if entry
|
||||
(manifest-entry->sexp entry)
|
||||
'()))
|
||||
(base `((id . ,(string-append
|
||||
(number->string pkg-address)
|
||||
":" output))
|
||||
(output . ,output)
|
||||
(installed . ,(->bool entry)))))
|
||||
(append entry-alist base pkg-alist)))
|
||||
|
||||
(define (obsolete-output-sexp entry)
|
||||
(let-values (((name version output)
|
||||
(manifest-entry->name+version+output entry)))
|
||||
(let ((base `((id . ,(make-package-specification
|
||||
name version output))
|
||||
(package-id . ,(name+version->full-name name version))
|
||||
(name . ,name)
|
||||
(version . ,version)
|
||||
(output . ,output)
|
||||
(obsolete . #t)
|
||||
(installed . #t))))
|
||||
(append (manifest-entry->sexp entry) base))))
|
||||
|
||||
(define* (sexps-by-package package #:optional output
|
||||
(entries (manifest-entries-by-name
|
||||
manifest
|
||||
(package-name package)
|
||||
(package-version package))))
|
||||
;; Assuming that PACKAGE has this OUTPUT.
|
||||
(let ((pkg-alist (package->sexp package))
|
||||
(address (object-address package))
|
||||
(outputs (if output
|
||||
(list output)
|
||||
(package-outputs package))))
|
||||
(map (lambda (output)
|
||||
(output-sexp pkg-alist address output
|
||||
(manifest-entry-by-output entries output)))
|
||||
outputs)))
|
||||
|
||||
(define* (sexps-by-manifest-entry entry #:optional
|
||||
(packages (manifest-entry->packages
|
||||
entry)))
|
||||
(if (null? packages)
|
||||
(list (obsolete-output-sexp entry))
|
||||
(map (lambda (package)
|
||||
(output-sexp (package->sexp package)
|
||||
(object-address package)
|
||||
(manifest-entry-output entry)
|
||||
entry))
|
||||
packages)))
|
||||
|
||||
(define (->sexps pattern)
|
||||
(match pattern
|
||||
((? package? package)
|
||||
(sexps-by-package package))
|
||||
((package (? string? output))
|
||||
(sexps-by-package package output))
|
||||
((? manifest-entry? entry)
|
||||
(list (obsolete-output-sexp entry)))
|
||||
((package entry)
|
||||
(sexps-by-manifest-entry entry (list package)))
|
||||
((name version output)
|
||||
(let ((packages (packages-by-name name version output)))
|
||||
(if (null? packages)
|
||||
(let ((entries (manifest-entries-by-name
|
||||
manifest name version output)))
|
||||
(append-map (cut sexps-by-manifest-entry <>)
|
||||
entries))
|
||||
(append-map (cut sexps-by-package <> output)
|
||||
packages))))
|
||||
(_ '())))
|
||||
|
||||
->sexps)
|
||||
|
||||
(define (entry-type-error entry-type)
|
||||
(error (format #f "Wrong entry-type '~a'" entry-type)))
|
||||
|
||||
(define (search-type-error entry-type search-type)
|
||||
(error (format #f "Wrong search type '~a' for entry-type '~a'"
|
||||
search-type entry-type)))
|
||||
|
||||
(define %pattern-transformers
|
||||
`((package . ,package-pattern-transformer)
|
||||
(output . ,output-pattern-transformer)))
|
||||
|
||||
(define (pattern-transformer entry-type)
|
||||
(assq-ref %pattern-transformers entry-type))
|
||||
|
||||
;; All procedures from inner alists are called with (MANIFEST . SEARCH-VALS)
|
||||
;; as arguments; see `package/output-sexps'.
|
||||
(define %patterns-makers
|
||||
(let* ((apply-to-rest (lambda (proc)
|
||||
(lambda (_ . rest) (apply proc rest))))
|
||||
(apply-to-first (lambda (proc)
|
||||
(lambda (first . _) (proc first))))
|
||||
(manifest-package-proc (apply-to-first manifest-package-patterns))
|
||||
(manifest-output-proc (apply-to-first manifest-output-patterns))
|
||||
(regexp-proc (lambda (_ regexp params . __)
|
||||
(packages-by-regexp regexp params)))
|
||||
(all-proc (lambda _ (all-available-packages)))
|
||||
(newest-proc (lambda _ (newest-available-packages))))
|
||||
`((package
|
||||
(id . ,(apply-to-rest ids->package-patterns))
|
||||
(name . ,(apply-to-rest specifications->package-patterns))
|
||||
(installed . ,manifest-package-proc)
|
||||
(generation . ,manifest-package-proc)
|
||||
(obsolete . ,(apply-to-first obsolete-package-patterns))
|
||||
(regexp . ,regexp-proc)
|
||||
(all-available . ,all-proc)
|
||||
(newest-available . ,newest-proc))
|
||||
(output
|
||||
(id . ,(apply-to-rest ids->output-patterns))
|
||||
(name . ,(apply-to-rest specifications->output-patterns))
|
||||
(installed . ,manifest-output-proc)
|
||||
(generation . ,manifest-output-proc)
|
||||
(obsolete . ,(apply-to-first obsolete-output-patterns))
|
||||
(regexp . ,regexp-proc)
|
||||
(all-available . ,all-proc)
|
||||
(newest-available . ,newest-proc)))))
|
||||
|
||||
(define (patterns-maker entry-type search-type)
|
||||
(or (and=> (assq-ref %patterns-makers entry-type)
|
||||
(cut assq-ref <> search-type))
|
||||
(search-type-error entry-type search-type)))
|
||||
|
||||
(define (package/output-sexps profile params entry-type
|
||||
search-type search-vals)
|
||||
"Return information about packages or package outputs.
|
||||
See 'entry-sexps' for details."
|
||||
(let* ((profile (if (eq? search-type 'generation)
|
||||
(generation-file-name profile (car search-vals))
|
||||
profile))
|
||||
(manifest (profile-manifest profile))
|
||||
(patterns (if (and (eq? entry-type 'output)
|
||||
(eq? search-type 'generation-diff))
|
||||
(match search-vals
|
||||
((g1 g2)
|
||||
(map specification->output-pattern
|
||||
(generation-difference profile g1 g2)))
|
||||
(_ '()))
|
||||
(apply (patterns-maker entry-type search-type)
|
||||
manifest search-vals)))
|
||||
(->sexps ((pattern-transformer entry-type) manifest params)))
|
||||
(append-map ->sexps patterns)))
|
||||
|
||||
|
||||
;;; Getting information about generations.
|
||||
|
||||
(define (generation-param-alist profile)
|
||||
"Return an alist of generation parameters and procedures for PROFILE."
|
||||
(let ((current (generation-number profile)))
|
||||
`((id . ,identity)
|
||||
(number . ,identity)
|
||||
(prev-number . ,(cut previous-generation-number profile <>))
|
||||
(current . ,(cut = current <>))
|
||||
(path . ,(cut generation-file-name profile <>))
|
||||
(time . ,(lambda (gen)
|
||||
(time-second (generation-time profile gen)))))))
|
||||
|
||||
(define (matching-generations profile predicate)
|
||||
"Return a list of PROFILE generations matching PREDICATE."
|
||||
(filter predicate (profile-generations profile)))
|
||||
|
||||
(define (last-generations profile number)
|
||||
"Return a list of last NUMBER generations.
|
||||
If NUMBER is 0 or less, return all generations."
|
||||
(let ((generations (profile-generations profile))
|
||||
(number (if (<= number 0) +inf.0 number)))
|
||||
(if (> (length generations) number)
|
||||
(list-head (reverse generations) number)
|
||||
generations)))
|
||||
|
||||
(define (find-generations profile search-type search-vals)
|
||||
"Find PROFILE's generations matching SEARCH-TYPE and SEARCH-VALS."
|
||||
(case search-type
|
||||
((id)
|
||||
(matching-generations profile (cut memq <> search-vals)))
|
||||
((last)
|
||||
(last-generations profile (car search-vals)))
|
||||
((all)
|
||||
(last-generations profile +inf.0))
|
||||
((time)
|
||||
(match search-vals
|
||||
((from to)
|
||||
(matching-generations
|
||||
profile
|
||||
(lambda (gen)
|
||||
(let ((time (time-second (generation-time profile gen))))
|
||||
(< from time to)))))
|
||||
(_ '())))
|
||||
(else (search-type-error "generation" search-type))))
|
||||
|
||||
(define (generation-sexps profile params search-type search-vals)
|
||||
"Return information about generations.
|
||||
See 'entry-sexps' for details."
|
||||
(let ((generations (find-generations profile search-type search-vals))
|
||||
(->sexp (object-transformer (generation-param-alist profile)
|
||||
params)))
|
||||
(map ->sexp generations)))
|
||||
|
||||
|
||||
;;; Getting package/output/generation entries (alists).
|
||||
|
||||
(define (entries profile params entry-type search-type search-vals)
|
||||
"Return information about entries.
|
||||
|
||||
ENTRY-TYPE is a symbol defining a type of returning information. Should
|
||||
be: 'package', 'output' or 'generation'.
|
||||
|
||||
SEARCH-TYPE and SEARCH-VALS define how to get the information.
|
||||
SEARCH-TYPE should 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 it is an empty list,
|
||||
get information with all available parameters, which are:
|
||||
|
||||
- If ENTRY-TYPE is 'package':
|
||||
'id', 'name', 'version', 'outputs', 'license', 'synopsis',
|
||||
'description', 'home-url', 'inputs', 'native-inputs',
|
||||
'propagated-inputs', 'location', 'installed'.
|
||||
|
||||
- If ENTRY-TYPE is 'output':
|
||||
'id', 'package-id', 'name', 'version', 'output', 'license',
|
||||
'synopsis', 'description', 'home-url', 'inputs', 'native-inputs',
|
||||
'propagated-inputs', 'location', 'installed', 'path', 'dependencies'.
|
||||
|
||||
- If ENTRY-TYPE is 'generation':
|
||||
'id', 'number', 'prev-number', 'path', 'time'.
|
||||
|
||||
Returning value is a list of alists. Each alist consists of
|
||||
parameter/value pairs."
|
||||
(case entry-type
|
||||
((package output)
|
||||
(package/output-sexps profile params entry-type
|
||||
search-type search-vals))
|
||||
((generation)
|
||||
(generation-sexps profile params
|
||||
search-type search-vals))
|
||||
(else (entry-type-error entry-type))))
|
||||
|
||||
|
||||
;;; Package actions.
|
||||
|
||||
(define* (package->manifest-entry* package #:optional output)
|
||||
(and package
|
||||
(begin
|
||||
(check-package-freshness package)
|
||||
(package->manifest-entry package output))))
|
||||
|
||||
(define* (make-install-manifest-entries id #:optional output)
|
||||
(package->manifest-entry* (package-by-id id) output))
|
||||
|
||||
(define* (make-upgrade-manifest-entries id #:optional output)
|
||||
(package->manifest-entry* (newest-package-by-id id) output))
|
||||
|
||||
(define* (make-manifest-pattern id #:optional output)
|
||||
"Make manifest pattern from a package ID and OUTPUT."
|
||||
(let-values (((name version)
|
||||
(id->name+version id)))
|
||||
(and name version
|
||||
(manifest-pattern
|
||||
(name name)
|
||||
(version version)
|
||||
(output output)))))
|
||||
|
||||
(define (convert-action-pattern pattern proc)
|
||||
"Convert action PATTERN into a list of objects returned by PROC.
|
||||
PROC is called: (PROC ID) or (PROC ID OUTPUT)."
|
||||
(match pattern
|
||||
((id . outputs)
|
||||
(if (null? outputs)
|
||||
(let ((obj (proc id)))
|
||||
(if obj (list obj) '()))
|
||||
(filter-map (cut proc id <>)
|
||||
outputs)))
|
||||
(_ '())))
|
||||
|
||||
(define (convert-action-patterns patterns proc)
|
||||
(append-map (cut convert-action-pattern <> proc)
|
||||
patterns))
|
||||
|
||||
(define* (process-package-actions
|
||||
profile #:key (install '()) (upgrade '()) (remove '())
|
||||
(use-substitutes? #t) dry-run?)
|
||||
"Perform package actions.
|
||||
|
||||
INSTALL, UPGRADE, REMOVE are lists of 'package action patterns'.
|
||||
Each pattern should have the following form:
|
||||
|
||||
(ID . OUTPUTS)
|
||||
|
||||
ID is an object address or a full-name of a package.
|
||||
OUTPUTS is a list of package outputs (may be an empty list)."
|
||||
(format #t "The process begins ...~%")
|
||||
(let* ((install (append
|
||||
(convert-action-patterns
|
||||
install make-install-manifest-entries)
|
||||
(convert-action-patterns
|
||||
upgrade make-upgrade-manifest-entries)))
|
||||
(remove (convert-action-patterns remove make-manifest-pattern))
|
||||
(transaction (manifest-transaction (install install)
|
||||
(remove remove)))
|
||||
(manifest (profile-manifest profile))
|
||||
(new-manifest (manifest-perform-transaction
|
||||
manifest transaction)))
|
||||
(unless (and (null? install) (null? remove))
|
||||
(with-store store
|
||||
(let* ((derivation (run-with-store store
|
||||
(profile-derivation new-manifest)))
|
||||
(derivations (list derivation))
|
||||
(new-profile (derivation->output-path derivation)))
|
||||
(set-build-options store
|
||||
#:use-substitutes? use-substitutes?)
|
||||
(show-manifest-transaction store manifest transaction
|
||||
#:dry-run? dry-run?)
|
||||
(show-what-to-build store derivations
|
||||
#:use-substitutes? use-substitutes?
|
||||
#:dry-run? dry-run?)
|
||||
(unless dry-run?
|
||||
(let ((name (generation-file-name
|
||||
profile
|
||||
(+ 1 (generation-number profile)))))
|
||||
(and (build-derivations store derivations)
|
||||
(let* ((entries (manifest-entries new-manifest))
|
||||
(count (length entries)))
|
||||
(switch-symlinks name new-profile)
|
||||
(switch-symlinks profile name)
|
||||
(format #t (N_ "~a package in profile~%"
|
||||
"~a packages in profile~%"
|
||||
count)
|
||||
count))))))))))
|
||||
|
||||
(define (delete-generations* profile generations)
|
||||
"Delete GENERATIONS from PROFILE.
|
||||
GENERATIONS is a list of generation numbers."
|
||||
(with-store store
|
||||
(delete-generations store profile generations)))
|
||||
|
||||
(define (package-source-derivation->store-path derivation)
|
||||
"Return a store path of the package source DERIVATION."
|
||||
(match (derivation-outputs derivation)
|
||||
;; Source derivation is always (("out" . derivation)).
|
||||
(((_ . output-drv))
|
||||
(derivation-output-path output-drv))
|
||||
(_ #f)))
|
||||
|
||||
(define (package-source-path package-id)
|
||||
"Return a store file path to a source of a package PACKAGE-ID."
|
||||
(and-let* ((package (package-by-id package-id))
|
||||
(source (package-source package)))
|
||||
(with-store store
|
||||
(package-source-derivation->store-path
|
||||
(package-source-derivation store source)))))
|
||||
|
||||
(define* (package-source-build-derivation package-id #:key dry-run?
|
||||
(use-substitutes? #t))
|
||||
"Build source derivation of a package PACKAGE-ID."
|
||||
(and-let* ((package (package-by-id package-id))
|
||||
(source (package-source package)))
|
||||
(with-store store
|
||||
(let* ((derivation (package-source-derivation store source))
|
||||
(derivations (list derivation)))
|
||||
(set-build-options store
|
||||
#:use-substitutes? use-substitutes?)
|
||||
(show-what-to-build store derivations
|
||||
#:use-substitutes? use-substitutes?
|
||||
#:dry-run? dry-run?)
|
||||
(unless dry-run?
|
||||
(build-derivations store derivations))
|
||||
(format #t "The source store path: ~a~%"
|
||||
(package-source-derivation->store-path derivation))))))
|
||||
@@ -0,0 +1,208 @@
|
||||
;;; guix-messages.el --- Minibuffer messages
|
||||
|
||||
;; 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 `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
|
||||
(0 "Packages not found.")
|
||||
(1 "")
|
||||
(many "%d packages." count))
|
||||
(name
|
||||
,(lambda (_ entries names)
|
||||
(guix-message-packages-by-name entries 'package names)))
|
||||
(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))
|
||||
(generation
|
||||
(0 "No packages installed in generation %d of profile '%s'."
|
||||
val profile)
|
||||
(1 "A single package installed in generation %d of profile '%s'."
|
||||
val profile)
|
||||
(many "%d packages installed in generation %d of profile '%s'."
|
||||
count val profile)))
|
||||
|
||||
(output
|
||||
(id
|
||||
(0 "Package outputs not found.")
|
||||
(1 "")
|
||||
(many "%d package outputs." count))
|
||||
(name
|
||||
,(lambda (_ entries names)
|
||||
(guix-message-packages-by-name entries 'output names)))
|
||||
(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))
|
||||
(generation
|
||||
(0 "No package outputs installed in generation %d of profile '%s'."
|
||||
val profile)
|
||||
(1 "A single package output installed in generation %d of profile '%s'."
|
||||
val profile)
|
||||
(many "%d package outputs installed in generation %d of profile '%s'."
|
||||
count val profile))
|
||||
(generation-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-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-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 (profile entries generations)
|
||||
"Display a message for outputs searched by GENERATIONS difference."
|
||||
(let* ((count (length entries))
|
||||
(str-beg (guix-message-string-entries count 'output))
|
||||
(gen1 (car generations))
|
||||
(gen2 (cadr generations)))
|
||||
(cl-multiple-value-bind (new old str-action)
|
||||
(if (> gen1 gen2)
|
||||
(list gen1 gen2 "added to")
|
||||
(list gen2 gen1 "removed from"))
|
||||
(message (concat "%s %s generation %d comparing with "
|
||||
"generation %d of profile '%s'.")
|
||||
str-beg str-action new old profile))))
|
||||
|
||||
(defun guix-result-message (profile entries entry-type
|
||||
search-type search-vals)
|
||||
"Display an appropriate message after displaying ENTRIES."
|
||||
(let* ((type-spec (guix-get-key-val guix-messages
|
||||
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-get-key-val 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
|
||||
@@ -0,0 +1,204 @@
|
||||
;;; guix-prettify.el --- Prettify Guix store file names
|
||||
|
||||
;; 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 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:
|
||||
|
||||
(defgroup guix-prettify nil
|
||||
"Prettify Guix store file names."
|
||||
:prefix "guix-prettify-"
|
||||
: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
|
||||
(rx "/"
|
||||
(or "nix" "gnu")
|
||||
"/store/"
|
||||
;; 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))
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward guix-prettify-regexp nil t)
|
||||
(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
|
||||
@@ -0,0 +1,175 @@
|
||||
;;; guix-utils.el --- General utility functions
|
||||
|
||||
;; 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 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))
|
||||
|
||||
(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))))
|
||||
|
||||
(defun guix-mapinsert (function sequence separator)
|
||||
"Like `mapconcat' but for inserting text.
|
||||
Apply FUNCTION to each element of SEQUENCE, and insert SEPARATOR
|
||||
at point between each FUNCTION call."
|
||||
(when sequence
|
||||
(funcall function (car sequence))
|
||||
(mapc (lambda (obj)
|
||||
(insert separator)
|
||||
(funcall function obj))
|
||||
(cdr sequence))))
|
||||
|
||||
(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-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 and STR is a one-line string longer than COL,
|
||||
split it into several short lines."
|
||||
(let ((strings (split-string str "\n *")))
|
||||
(if (and col
|
||||
(null (cdr strings)) ; if not multi-line
|
||||
(> (length str) col))
|
||||
(split-string (guix-get-filled-string str col) "\n")
|
||||
strings)))
|
||||
|
||||
(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-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-get-key-val (alist &rest keys)
|
||||
"Return value from ALIST by KEYS.
|
||||
ALIST is alist of alists of alists ... which can be consecutively
|
||||
accessed with KEYS."
|
||||
(let ((val alist))
|
||||
(dolist (key keys val)
|
||||
(setq val (cdr (assq key val))))))
|
||||
|
||||
(defun guix-find-file (file)
|
||||
"Find FILE if it exists."
|
||||
(if (file-exists-p file)
|
||||
(find-file file)
|
||||
(message "File '%s' does not exist." file)))
|
||||
|
||||
|
||||
;;; 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))
|
||||
|
||||
(provide 'guix-utils)
|
||||
|
||||
;;; guix-utils.el ends here
|
||||
+198
@@ -0,0 +1,198 @@
|
||||
;;; guix.el --- Interface for GNU Guix package manager
|
||||
|
||||
;; Copyright © 2014 Alex Kost <alezost@gmail.com>
|
||||
|
||||
;; Package-Requires: ((geiser "0.3"))
|
||||
;; Keywords: tools
|
||||
|
||||
;; 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 an interface for searching, listing and getting
|
||||
;; information about Guix packages and generations; and for
|
||||
;; installing/upgrading/removing packages.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'guix-base)
|
||||
(require 'guix-list)
|
||||
(require 'guix-info)
|
||||
(require 'guix-utils)
|
||||
|
||||
(defgroup guix nil
|
||||
"Interface for Guix package manager."
|
||||
:prefix "guix-"
|
||||
:group 'external)
|
||||
|
||||
(defcustom guix-list-single-package nil
|
||||
"If non-nil, list a package even if it is the only matching result.
|
||||
If nil, show a single package in the info buffer."
|
||||
:type 'boolean
|
||||
:group 'guix)
|
||||
|
||||
(defvar guix-search-params '(name synopsis description)
|
||||
"Default list of package parameters for searching by regexp.")
|
||||
|
||||
(defvar guix-search-history nil
|
||||
"A history of minibuffer prompts.")
|
||||
|
||||
(defun guix-get-show-packages (profile search-type &rest search-vals)
|
||||
"Search for packages and show results.
|
||||
|
||||
If PROFILE is nil, use `guix-current-profile'.
|
||||
|
||||
See `guix-get-entries' for the meaning of SEARCH-TYPE and
|
||||
SEARCH-VALS.
|
||||
|
||||
Results are displayed in the list buffer, unless a single package
|
||||
is found and `guix-list-single-package' is nil."
|
||||
(or profile (setq profile guix-current-profile))
|
||||
(let ((packages (guix-get-entries profile guix-package-list-type
|
||||
search-type search-vals
|
||||
(guix-get-params-for-receiving
|
||||
'list guix-package-list-type))))
|
||||
(if (or guix-list-single-package
|
||||
(cdr packages))
|
||||
(guix-set-buffer profile packages 'list guix-package-list-type
|
||||
search-type search-vals)
|
||||
(let ((packages (guix-get-entries profile guix-package-info-type
|
||||
search-type search-vals
|
||||
(guix-get-params-for-receiving
|
||||
'info guix-package-info-type))))
|
||||
(guix-set-buffer profile packages 'info guix-package-info-type
|
||||
search-type search-vals)))))
|
||||
|
||||
(defun guix-get-show-generations (profile search-type &rest search-vals)
|
||||
"Search for generations and show results.
|
||||
|
||||
If PROFILE is nil, use `guix-current-profile'.
|
||||
|
||||
See `guix-get-entries' for the meaning of SEARCH-TYPE and
|
||||
SEARCH-VALS."
|
||||
(apply #'guix-get-show-entries
|
||||
(or profile guix-current-profile)
|
||||
'list 'generation search-type search-vals))
|
||||
|
||||
;;;###autoload
|
||||
(defun guix-search-by-name (name &optional profile)
|
||||
"Search for Guix packages by NAME.
|
||||
NAME is a string with name specification. It may optionally contain
|
||||
a version number. Examples: \"guile\", \"guile-2.0.11\".
|
||||
|
||||
If PROFILE is nil, use `guix-current-profile'.
|
||||
Interactively with prefix, prompt for PROFILE."
|
||||
(interactive
|
||||
(list (read-string "Package name: " nil 'guix-search-history)
|
||||
(and current-prefix-arg
|
||||
(guix-profile-prompt))))
|
||||
(guix-get-show-packages profile 'name name))
|
||||
|
||||
;;;###autoload
|
||||
(defun guix-search-by-regexp (regexp &optional params profile)
|
||||
"Search for Guix packages by REGEXP.
|
||||
PARAMS are package parameters that should be searched.
|
||||
If PARAMS are not specified, use `guix-search-params'.
|
||||
|
||||
If PROFILE is nil, use `guix-current-profile'.
|
||||
Interactively with prefix, prompt for PROFILE."
|
||||
(interactive
|
||||
(list (read-regexp "Regexp: " nil 'guix-search-history)
|
||||
nil
|
||||
(and current-prefix-arg
|
||||
(guix-profile-prompt))))
|
||||
(guix-get-show-packages profile 'regexp regexp
|
||||
(or params guix-search-params)))
|
||||
|
||||
;;;###autoload
|
||||
(defun guix-installed-packages (&optional profile)
|
||||
"Display information about installed Guix packages.
|
||||
If PROFILE is nil, use `guix-current-profile'.
|
||||
Interactively with prefix, prompt for PROFILE."
|
||||
(interactive
|
||||
(list (and current-prefix-arg
|
||||
(guix-profile-prompt))))
|
||||
(guix-get-show-packages profile 'installed))
|
||||
|
||||
;;;###autoload
|
||||
(defun guix-obsolete-packages (&optional profile)
|
||||
"Display information about obsolete Guix packages.
|
||||
If PROFILE is nil, use `guix-current-profile'.
|
||||
Interactively with prefix, prompt for PROFILE."
|
||||
(interactive
|
||||
(list (and current-prefix-arg
|
||||
(guix-profile-prompt))))
|
||||
(guix-get-show-packages profile 'obsolete))
|
||||
|
||||
;;;###autoload
|
||||
(defun guix-all-available-packages (&optional profile)
|
||||
"Display information about all available Guix packages.
|
||||
If PROFILE is nil, use `guix-current-profile'.
|
||||
Interactively with prefix, prompt for PROFILE."
|
||||
(interactive
|
||||
(list (and current-prefix-arg
|
||||
(guix-profile-prompt))))
|
||||
(guix-get-show-packages profile 'all-available))
|
||||
|
||||
;;;###autoload
|
||||
(defun guix-newest-available-packages (&optional profile)
|
||||
"Display information about the newest available Guix packages.
|
||||
If PROFILE is nil, use `guix-current-profile'.
|
||||
Interactively with prefix, prompt for PROFILE."
|
||||
(interactive
|
||||
(list (and current-prefix-arg
|
||||
(guix-profile-prompt))))
|
||||
(guix-get-show-packages profile 'newest-available))
|
||||
|
||||
;;;###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 (and current-prefix-arg
|
||||
(guix-profile-prompt))))
|
||||
(guix-get-show-generations 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: ")
|
||||
(and current-prefix-arg
|
||||
(guix-profile-prompt))))
|
||||
(guix-get-show-generations 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): ")
|
||||
(and current-prefix-arg
|
||||
(guix-profile-prompt))))
|
||||
(guix-get-show-generations profile 'time
|
||||
(float-time from)
|
||||
(float-time to)))
|
||||
|
||||
(provide 'guix)
|
||||
|
||||
;;; guix.el ends here
|
||||
+75
-21
@@ -23,12 +23,15 @@
|
||||
|
||||
GNU_SYSTEM_MODULES = \
|
||||
gnu.scm \
|
||||
gnu/artwork.scm \
|
||||
gnu/packages.scm \
|
||||
gnu/packages/abiword.scm \
|
||||
gnu/packages/acct.scm \
|
||||
gnu/packages/acl.scm \
|
||||
gnu/packages/admin.scm \
|
||||
gnu/packages/adns.scm \
|
||||
gnu/packages/algebra.scm \
|
||||
gnu/packages/aidc.scm \
|
||||
gnu/packages/aidc.scm \
|
||||
gnu/packages/apl.scm \
|
||||
gnu/packages/apr.scm \
|
||||
gnu/packages/asciidoc.scm \
|
||||
@@ -40,7 +43,6 @@ GNU_SYSTEM_MODULES = \
|
||||
gnu/packages/backup.scm \
|
||||
gnu/packages/base.scm \
|
||||
gnu/packages/bash.scm \
|
||||
gnu/packages/bdb.scm \
|
||||
gnu/packages/bdw-gc.scm \
|
||||
gnu/packages/bittorrent.scm \
|
||||
gnu/packages/bison.scm \
|
||||
@@ -53,10 +55,11 @@ GNU_SYSTEM_MODULES = \
|
||||
gnu/packages/cflow.scm \
|
||||
gnu/packages/check.scm \
|
||||
gnu/packages/cmake.scm \
|
||||
gnu/packages/commencement.scm \
|
||||
gnu/packages/compression.scm \
|
||||
gnu/packages/complexity.scm \
|
||||
gnu/packages/conkeror.scm \
|
||||
gnu/packages/cook.scm \
|
||||
gnu/packages/cook.scm \
|
||||
gnu/packages/cpio.scm \
|
||||
gnu/packages/cppi.scm \
|
||||
gnu/packages/cross-base.scm \
|
||||
@@ -65,6 +68,7 @@ GNU_SYSTEM_MODULES = \
|
||||
gnu/packages/curl.scm \
|
||||
gnu/packages/cursynth.scm \
|
||||
gnu/packages/cyrus-sasl.scm \
|
||||
gnu/packages/databases.scm \
|
||||
gnu/packages/datamash.scm \
|
||||
gnu/packages/dc.scm \
|
||||
gnu/packages/dejagnu.scm \
|
||||
@@ -76,14 +80,19 @@ GNU_SYSTEM_MODULES = \
|
||||
gnu/packages/ed.scm \
|
||||
gnu/packages/elf.scm \
|
||||
gnu/packages/emacs.scm \
|
||||
gnu/packages/enchant.scm \
|
||||
gnu/packages/feh.scm \
|
||||
gnu/packages/file.scm \
|
||||
gnu/packages/firmware.scm \
|
||||
gnu/packages/fish.scm \
|
||||
gnu/packages/flashing-tools.scm \
|
||||
gnu/packages/flex.scm \
|
||||
gnu/packages/fltk.scm \
|
||||
gnu/packages/fonts.scm \
|
||||
gnu/packages/fontutils.scm \
|
||||
gnu/packages/freeipmi.scm \
|
||||
gnu/packages/ftp.scm \
|
||||
gnu/packages/fribidi.scm \
|
||||
gnu/packages/games.scm \
|
||||
gnu/packages/gawk.scm \
|
||||
gnu/packages/gcal.scm \
|
||||
@@ -94,7 +103,6 @@ GNU_SYSTEM_MODULES = \
|
||||
gnu/packages/geeqie.scm \
|
||||
gnu/packages/gettext.scm \
|
||||
gnu/packages/ghostscript.scm \
|
||||
gnu/packages/giflib.scm \
|
||||
gnu/packages/gimp.scm \
|
||||
gnu/packages/gkrellm.scm \
|
||||
gnu/packages/gl.scm \
|
||||
@@ -109,6 +117,7 @@ GNU_SYSTEM_MODULES = \
|
||||
gnu/packages/gnu-pw-mgr.scm \
|
||||
gnu/packages/gperf.scm \
|
||||
gnu/packages/gprolog.scm \
|
||||
gnu/packages/gps.scm \
|
||||
gnu/packages/graphviz.scm \
|
||||
gnu/packages/groff.scm \
|
||||
gnu/packages/grub.scm \
|
||||
@@ -149,12 +158,11 @@ GNU_SYSTEM_MODULES = \
|
||||
gnu/packages/lightning.scm \
|
||||
gnu/packages/links.scm \
|
||||
gnu/packages/linux.scm \
|
||||
gnu/packages/lisp.scm \
|
||||
gnu/packages/lisp.scm \
|
||||
gnu/packages/lout.scm \
|
||||
gnu/packages/lsh.scm \
|
||||
gnu/packages/lsof.scm \
|
||||
gnu/packages/lua.scm \
|
||||
gnu/packages/lvm.scm \
|
||||
gnu/packages/lynx.scm \
|
||||
gnu/packages/m4.scm \
|
||||
gnu/packages/man.scm \
|
||||
@@ -164,6 +172,7 @@ GNU_SYSTEM_MODULES = \
|
||||
gnu/packages/mc.scm \
|
||||
gnu/packages/mcrypt.scm \
|
||||
gnu/packages/messaging.scm \
|
||||
gnu/packages/miscfiles.scm \
|
||||
gnu/packages/mit-krb5.scm \
|
||||
gnu/packages/moe.scm \
|
||||
gnu/packages/mpd.scm \
|
||||
@@ -171,7 +180,6 @@ GNU_SYSTEM_MODULES = \
|
||||
gnu/packages/mpi.scm \
|
||||
gnu/packages/multiprecision.scm \
|
||||
gnu/packages/mtools.scm \
|
||||
gnu/packages/mysql.scm \
|
||||
gnu/packages/nano.scm \
|
||||
gnu/packages/ncdu.scm \
|
||||
gnu/packages/ncurses.scm \
|
||||
@@ -179,11 +187,15 @@ GNU_SYSTEM_MODULES = \
|
||||
gnu/packages/nettle.scm \
|
||||
gnu/packages/node.scm \
|
||||
gnu/packages/noweb.scm \
|
||||
gnu/packages/ntp.scm \
|
||||
gnu/packages/nvi.scm \
|
||||
gnu/packages/ocaml.scm \
|
||||
gnu/packages/ocrad.scm \
|
||||
gnu/packages/onc-rpc.scm \
|
||||
gnu/packages/openldap.scm \
|
||||
gnu/packages/openssl.scm \
|
||||
gnu/packages/orpheus.scm \
|
||||
gnu/packages/ots.scm \
|
||||
gnu/packages/package-management.scm \
|
||||
gnu/packages/parallel.scm \
|
||||
gnu/packages/patchutils.scm \
|
||||
@@ -195,6 +207,7 @@ GNU_SYSTEM_MODULES = \
|
||||
gnu/packages/photo.scm \
|
||||
gnu/packages/pkg-config.scm \
|
||||
gnu/packages/plotutils.scm \
|
||||
gnu/packages/polkit.scm \
|
||||
gnu/packages/popt.scm \
|
||||
gnu/packages/pth.scm \
|
||||
gnu/packages/pulseaudio.scm \
|
||||
@@ -206,12 +219,15 @@ GNU_SYSTEM_MODULES = \
|
||||
gnu/packages/ratpoison.scm \
|
||||
gnu/packages/rdf.scm \
|
||||
gnu/packages/readline.scm \
|
||||
gnu/packages/recutils.scm \
|
||||
gnu/packages/rrdtool.scm \
|
||||
gnu/packages/rsync.scm \
|
||||
gnu/packages/ruby.scm \
|
||||
gnu/packages/rush.scm \
|
||||
gnu/packages/samba.scm \
|
||||
gnu/packages/scanner.scm \
|
||||
gnu/packages/scheme.scm \
|
||||
gnu/packages/screen.scm \
|
||||
gnu/packages/scrot.scm \
|
||||
gnu/packages/sdl.scm \
|
||||
gnu/packages/search.scm \
|
||||
gnu/packages/serveez.scm \
|
||||
@@ -219,10 +235,10 @@ GNU_SYSTEM_MODULES = \
|
||||
gnu/packages/skribilo.scm \
|
||||
gnu/packages/slim.scm \
|
||||
gnu/packages/smalltalk.scm \
|
||||
gnu/packages/sqlite.scm \
|
||||
gnu/packages/ssh.scm \
|
||||
gnu/packages/stalonetray.scm \
|
||||
gnu/packages/swig.scm \
|
||||
gnu/packages/synergy.scm \
|
||||
gnu/packages/tcl.scm \
|
||||
gnu/packages/tcsh.scm \
|
||||
gnu/packages/telephony.scm \
|
||||
@@ -231,9 +247,10 @@ GNU_SYSTEM_MODULES = \
|
||||
gnu/packages/time.scm \
|
||||
gnu/packages/tmux.scm \
|
||||
gnu/packages/tor.scm \
|
||||
gnu/packages/uucp.scm \
|
||||
gnu/packages/unclutter.scm \
|
||||
gnu/packages/unrtf.scm \
|
||||
gnu/packages/upnp.scm \
|
||||
gnu/packages/uucp.scm \
|
||||
gnu/packages/valgrind.scm \
|
||||
gnu/packages/version-control.scm \
|
||||
gnu/packages/video.scm \
|
||||
@@ -243,9 +260,12 @@ GNU_SYSTEM_MODULES = \
|
||||
gnu/packages/w3m.scm \
|
||||
gnu/packages/wdiff.scm \
|
||||
gnu/packages/web.scm \
|
||||
gnu/packages/weechat.scm \
|
||||
gnu/packages/wget.scm \
|
||||
gnu/packages/which.scm \
|
||||
gnu/packages/wordnet.scm \
|
||||
gnu/packages/wv.scm \
|
||||
gnu/packages/xfig.scm \
|
||||
gnu/packages/xiph.scm \
|
||||
gnu/packages/xlockmore.scm \
|
||||
gnu/packages/xml.scm \
|
||||
@@ -254,6 +274,7 @@ GNU_SYSTEM_MODULES = \
|
||||
gnu/packages/yasm.scm \
|
||||
gnu/packages/zile.scm \
|
||||
gnu/packages/zip.scm \
|
||||
gnu/packages/zsh.scm \
|
||||
\
|
||||
gnu/services.scm \
|
||||
gnu/services/avahi.scm \
|
||||
@@ -268,41 +289,61 @@ GNU_SYSTEM_MODULES = \
|
||||
gnu/system/file-systems.scm \
|
||||
gnu/system/grub.scm \
|
||||
gnu/system/install.scm \
|
||||
gnu/system/os-config.tmpl \
|
||||
gnu/system/linux.scm \
|
||||
gnu/system/linux-initrd.scm \
|
||||
gnu/system/shadow.scm \
|
||||
gnu/system/vm.scm
|
||||
gnu/system/vm.scm \
|
||||
\
|
||||
gnu/build/activation.scm \
|
||||
gnu/build/file-systems.scm \
|
||||
gnu/build/install.scm \
|
||||
gnu/build/linux-boot.scm \
|
||||
gnu/build/linux-initrd.scm \
|
||||
gnu/build/vm.scm
|
||||
|
||||
|
||||
patchdir = $(guilemoduledir)/gnu/packages/patches
|
||||
dist_patch_DATA = \
|
||||
gnu/packages/patches/abiword-explictly-cast-bools.patch \
|
||||
gnu/packages/patches/abiword-link-plugins-against-backend.patch \
|
||||
gnu/packages/patches/abiword-no-include-glib-internal-headers.patch \
|
||||
gnu/packages/patches/abiword-pass-no-undefined-to-linker.patch \
|
||||
gnu/packages/patches/abiword-use-proper-png-api.patch \
|
||||
gnu/packages/patches/abiword-wmf-version-lookup-fix.patch \
|
||||
gnu/packages/patches/alsa-lib-mips-atomic-fix.patch \
|
||||
gnu/packages/patches/apr-skip-getservbyname-test.patch \
|
||||
gnu/packages/patches/ath9k-htc-firmware-binutils.patch \
|
||||
gnu/packages/patches/ath9k-htc-firmware-gcc.patch \
|
||||
gnu/packages/patches/ath9k-htc-firmware-objcopy.patch \
|
||||
gnu/packages/patches/automake-skip-amhello-tests.patch \
|
||||
gnu/packages/patches/avahi-localstatedir.patch \
|
||||
gnu/packages/patches/avrdude-fix-libusb.patch \
|
||||
gnu/packages/patches/bigloo-gc-shebangs.patch \
|
||||
gnu/packages/patches/binutils-ld-new-dtags.patch \
|
||||
gnu/packages/patches/binutils-loongson-workaround.patch \
|
||||
gnu/packages/patches/ccache-stdc-predef-test.patch \
|
||||
gnu/packages/patches/cdparanoia-fpic.patch \
|
||||
gnu/packages/patches/clucene-pkgconfig.patch \
|
||||
gnu/packages/patches/cmake-fix-tests.patch \
|
||||
gnu/packages/patches/coreutils-dummy-man.patch \
|
||||
gnu/packages/patches/coreutils-skip-nohup.patch \
|
||||
gnu/packages/patches/cpio-gets-undeclared.patch \
|
||||
gnu/packages/patches/cssc-gets-undeclared.patch \
|
||||
gnu/packages/patches/cssc-missing-include.patch \
|
||||
gnu/packages/patches/curl-fix-test172.patch \
|
||||
gnu/packages/patches/cursynth-wave-rand.patch \
|
||||
gnu/packages/patches/dbus-localstatedir.patch \
|
||||
gnu/packages/patches/diffutils-gets-undeclared.patch \
|
||||
gnu/packages/patches/dfu-programmer-fix-libusb.patch \
|
||||
gnu/packages/patches/doxygen-test.patch \
|
||||
gnu/packages/patches/doxygen-tmake.patch \
|
||||
gnu/packages/patches/emacs-configure-sh.patch \
|
||||
gnu/packages/patches/duplicity-piped-password.patch \
|
||||
gnu/packages/patches/duplicity-test_selection-tmp.patch \
|
||||
gnu/packages/patches/eudev-rules-directory.patch \
|
||||
gnu/packages/patches/file-CVE-2014-3587.patch \
|
||||
gnu/packages/patches/findutils-absolute-paths.patch \
|
||||
gnu/packages/patches/flashrom-use-libftdi1.patch \
|
||||
gnu/packages/patches/flex-bison-tests.patch \
|
||||
gnu/packages/patches/gawk-shell.patch \
|
||||
gnu/packages/patches/gcc-cross-environment-variables.patch \
|
||||
gnu/packages/patches/gcc-fix-pr61801.patch \
|
||||
gnu/packages/patches/gd-mips64-deplibs-fix.patch \
|
||||
gnu/packages/patches/glib-tests-desktop.patch \
|
||||
gnu/packages/patches/glib-tests-homedir.patch \
|
||||
@@ -319,23 +360,26 @@ dist_patch_DATA = \
|
||||
gnu/packages/patches/guile-1.8-cpp-4.5.patch \
|
||||
gnu/packages/patches/guile-default-utf8.patch \
|
||||
gnu/packages/patches/guile-linux-syscalls.patch \
|
||||
gnu/packages/patches/guile-ncurses-tests.patch \
|
||||
gnu/packages/patches/guile-relocatable.patch \
|
||||
gnu/packages/patches/guix-test-networking.patch \
|
||||
gnu/packages/patches/gtkglext-disable-disable-deprecated.patch \
|
||||
gnu/packages/patches/hop-bigloo-4.0b.patch \
|
||||
gnu/packages/patches/icu4c-test-date-format.patch \
|
||||
gnu/packages/patches/inkscape-stray-comma.patch \
|
||||
gnu/packages/patches/jbig2dec-ignore-testtest.patch \
|
||||
gnu/packages/patches/kmod-module-directory.patch \
|
||||
gnu/packages/patches/libarchive-CVE-2013-0211.patch \
|
||||
gnu/packages/patches/libarchive-fix-lzo-test-case.patch \
|
||||
gnu/packages/patches/libarchive-mtree-filename-length-fix.patch \
|
||||
gnu/packages/patches/libbonobo-activation-test-race.patch \
|
||||
gnu/packages/patches/libevent-dns-tests.patch \
|
||||
gnu/packages/patches/libffi-mips-n32-fix.patch \
|
||||
gnu/packages/patches/liboop-mips64-deplibs-fix.patch \
|
||||
gnu/packages/patches/libmad-mips-newgcc.patch \
|
||||
gnu/packages/patches/libtheora-config-guess.patch \
|
||||
gnu/packages/patches/libtool-skip-tests.patch \
|
||||
gnu/packages/patches/libtool-skip-tests-for-mips.patch \
|
||||
gnu/packages/patches/libssh-CVE-2014-0017.patch \
|
||||
gnu/packages/patches/lm-sensors-hwmon-attrs.patch \
|
||||
gnu/packages/patches/luit-posix.patch \
|
||||
gnu/packages/patches/m4-gets-undeclared.patch \
|
||||
gnu/packages/patches/m4-readlink-EINVAL.patch \
|
||||
@@ -343,9 +387,15 @@ dist_patch_DATA = \
|
||||
gnu/packages/patches/mc-fix-ncurses-build.patch \
|
||||
gnu/packages/patches/mcron-install.patch \
|
||||
gnu/packages/patches/mhash-keygen-test-segfault.patch \
|
||||
gnu/packages/patches/minetest-subgame-env-var.patch \
|
||||
gnu/packages/patches/mit-krb5-init-fix.patch \
|
||||
gnu/packages/patches/mpc123-initialize-ao.patch \
|
||||
gnu/packages/patches/module-init-tools-moduledir.patch \
|
||||
gnu/packages/patches/mupdf-buildsystem-fix.patch \
|
||||
gnu/packages/patches/net-tools-bitrot.patch \
|
||||
gnu/packages/patches/nvi-assume-preserve-path.patch \
|
||||
gnu/packages/patches/orpheus-cast-errors-and-includes.patch \
|
||||
gnu/packages/patches/ots-no-include-missing-file.patch \
|
||||
gnu/packages/patches/patchelf-page-size.patch \
|
||||
gnu/packages/patches/patchutils-xfail-gendiff-tests.patch \
|
||||
gnu/packages/patches/perl-no-sys-dirs.patch \
|
||||
@@ -353,7 +403,10 @@ dist_patch_DATA = \
|
||||
gnu/packages/patches/petsc-fix-threadcomm.patch \
|
||||
gnu/packages/patches/pingus-sdl-libs-config.patch \
|
||||
gnu/packages/patches/plotutils-libpng-jmpbuf.patch \
|
||||
gnu/packages/patches/polkit-drop-test.patch \
|
||||
gnu/packages/patches/procps-make-3.82.patch \
|
||||
gnu/packages/patches/pulseaudio-CVE-2014-3970.patch \
|
||||
gnu/packages/patches/pulseaudio-fix-mult-test.patch \
|
||||
gnu/packages/patches/pybugz-encode-error.patch \
|
||||
gnu/packages/patches/pybugz-stty.patch \
|
||||
gnu/packages/patches/python-fix-tests.patch \
|
||||
@@ -373,13 +426,14 @@ dist_patch_DATA = \
|
||||
gnu/packages/patches/superlu-dist-scotchmetis.patch \
|
||||
gnu/packages/patches/tcsh-fix-autotest.patch \
|
||||
gnu/packages/patches/teckit-cstdio.patch \
|
||||
gnu/packages/patches/texi2html-document-encoding.patch \
|
||||
gnu/packages/patches/texi2html-i18n.patch \
|
||||
gnu/packages/patches/udev-gir-libtool.patch \
|
||||
gnu/packages/patches/util-linux-perl.patch \
|
||||
gnu/packages/patches/valgrind-glibc.patch \
|
||||
gnu/packages/patches/vpnc-script.patch \
|
||||
gnu/packages/patches/w3m-fix-compile.patch \
|
||||
gnu/packages/patches/xmodmap-asprintf.patch \
|
||||
gnu/packages/patches/xpdf-constchar.patch
|
||||
gnu/packages/patches/xf86-input-synaptics-glibc-2.20.patch \
|
||||
gnu/packages/patches/xmodmap-asprintf.patch
|
||||
|
||||
bootstrapdir = $(guilemoduledir)/gnu/packages/bootstrap
|
||||
bootstrap_x86_64_linuxdir = $(bootstrapdir)/x86_64-linux
|
||||
|
||||
@@ -36,7 +36,8 @@
|
||||
(gnu services)
|
||||
(gnu services base)
|
||||
(gnu packages)
|
||||
(gnu packages base)))
|
||||
(gnu packages base)
|
||||
(guix gexp))) ; so gexps can be used
|
||||
|
||||
(for-each (let ((i (module-public-interface (current-module))))
|
||||
(lambda (m)
|
||||
|
||||
@@ -0,0 +1,40 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2014 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/>.
|
||||
|
||||
(define-module (gnu artwork)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix git-download)
|
||||
#:export (%artwork-repository))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
;;; Common place for the definition of the Guix artwork repository.
|
||||
;;;
|
||||
;;; Code:
|
||||
|
||||
(define %artwork-repository
|
||||
(origin
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
(url "git://git.savannah.gnu.org/guix/guix-artwork.git")
|
||||
(commit "94e6111")))
|
||||
(sha256
|
||||
(base32
|
||||
"0aax85mygpq4lbyn8sriafikyg54yss3lisin6pwkvlvp23a3v1j"))))
|
||||
|
||||
;;; artwork.scm ends here
|
||||
@@ -16,9 +16,9 @@
|
||||
;;; 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 (guix build activation)
|
||||
(define-module (gnu build activation)
|
||||
#:use-module (gnu build linux-boot)
|
||||
#:use-module (guix build utils)
|
||||
#:use-module (guix build linux-initrd)
|
||||
#:use-module (ice-9 ftw)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (srfi srfi-1)
|
||||
@@ -26,6 +26,9 @@
|
||||
#:export (activate-users+groups
|
||||
activate-etc
|
||||
activate-setuid-programs
|
||||
activate-/bin/sh
|
||||
activate-modprobe
|
||||
activate-firmware
|
||||
activate-current-system))
|
||||
|
||||
;;; Commentary:
|
||||
@@ -87,6 +90,33 @@ properties. Return #t on success."
|
||||
,name)))
|
||||
(zero? (apply system* "useradd" args)))))
|
||||
|
||||
(define* (modify-user name group
|
||||
#:key uid comment home shell password system?
|
||||
(supplementary-groups '())
|
||||
(log-port (current-error-port)))
|
||||
"Modify user account NAME to have all the given settings."
|
||||
;; Use 'usermod' from the Shadow package.
|
||||
(let ((args `(,@(if uid `("-u" ,(number->string uid)) '())
|
||||
"-g" ,(if (number? group) (number->string group) group)
|
||||
,@(if (pair? supplementary-groups)
|
||||
`("-G" ,(string-join supplementary-groups ","))
|
||||
'())
|
||||
,@(if comment `("-c" ,comment) '())
|
||||
;; Don't use '--move-home', so ignore HOME.
|
||||
,@(if shell `("-s" ,shell) '())
|
||||
,name)))
|
||||
(zero? (apply system* "usermod" args))))
|
||||
|
||||
(define* (ensure-user name group
|
||||
#:key uid comment home shell password system?
|
||||
(supplementary-groups '())
|
||||
(log-port (current-error-port))
|
||||
#:rest rest)
|
||||
"Make sure user NAME exists and has the relevant settings."
|
||||
(if (false-if-exception (getpwnam name))
|
||||
(apply modify-user name group rest)
|
||||
(apply add-user name group rest)))
|
||||
|
||||
(define (activate-users+groups users groups)
|
||||
"Make sure the accounts listed in USERS and the user groups listed in GROUPS
|
||||
are all available.
|
||||
@@ -100,23 +130,22 @@ numeric gid or #f."
|
||||
(define activate-user
|
||||
(match-lambda
|
||||
((name uid group supplementary-groups comment home shell password system?)
|
||||
(unless (false-if-exception (getpwnam name))
|
||||
(let ((profile-dir (string-append "/var/guix/profiles/per-user/"
|
||||
name)))
|
||||
(add-user name group
|
||||
#:uid uid
|
||||
#:system? system?
|
||||
#:supplementary-groups supplementary-groups
|
||||
#:comment comment
|
||||
#:home home
|
||||
#:shell shell
|
||||
#:password password)
|
||||
(let ((profile-dir (string-append "/var/guix/profiles/per-user/"
|
||||
name)))
|
||||
(ensure-user name group
|
||||
#:uid uid
|
||||
#:system? system?
|
||||
#:supplementary-groups supplementary-groups
|
||||
#:comment comment
|
||||
#:home home
|
||||
#:shell shell
|
||||
#:password password)
|
||||
|
||||
(unless system?
|
||||
;; Create the profile directory for the new account.
|
||||
(let ((pw (getpwnam name)))
|
||||
(mkdir-p profile-dir)
|
||||
(chown profile-dir (passwd:uid pw) (passwd:gid pw)))))))))
|
||||
(unless system?
|
||||
;; Create the profile directory for the new account.
|
||||
(let ((pw (getpwnam name)))
|
||||
(mkdir-p profile-dir)
|
||||
(chown profile-dir (passwd:uid pw) (passwd:gid pw))))))))
|
||||
|
||||
;; 'groupadd' aborts if the file doesn't already exist.
|
||||
(touch "/etc/group")
|
||||
@@ -146,48 +175,64 @@ numeric gid or #f."
|
||||
;; /etc is a mixture of static and dynamic settings. Here is where we
|
||||
;; initialize it from the static part.
|
||||
|
||||
(define (rm-f file)
|
||||
(false-if-exception (delete-file file)))
|
||||
|
||||
(format #t "populating /etc from ~a...~%" etc)
|
||||
(let ((rm-f (lambda (f)
|
||||
(false-if-exception (delete-file f)))))
|
||||
(rm-f "/etc/static")
|
||||
(symlink etc "/etc/static")
|
||||
(for-each (lambda (file)
|
||||
;; TODO: Handle 'shadow' specially so that changed
|
||||
;; password aren't lost.
|
||||
(let ((target (string-append "/etc/" file))
|
||||
(source (string-append "/etc/static/" file)))
|
||||
(rm-f target)
|
||||
(symlink source target)))
|
||||
(scandir etc
|
||||
(lambda (file)
|
||||
(not (member file '("." ".."))))
|
||||
|
||||
;; The default is 'string-locale<?', but we don't have
|
||||
;; it when run from the initrd's statically-linked
|
||||
;; Guile.
|
||||
string<?))
|
||||
(rm-f "/etc/static")
|
||||
(symlink etc "/etc/static")
|
||||
(for-each (lambda (file)
|
||||
(let ((target (string-append "/etc/" file))
|
||||
(source (string-append "/etc/static/" file)))
|
||||
(rm-f target)
|
||||
|
||||
;; Prevent ETC from being GC'd.
|
||||
(rm-f "/var/guix/gcroots/etc-directory")
|
||||
(symlink etc "/var/guix/gcroots/etc-directory")))
|
||||
;; Things such as /etc/sudoers must be regular files, not
|
||||
;; symlinks; furthermore, they could be modified behind our
|
||||
;; back---e.g., with 'visudo'. Thus, make a copy instead of
|
||||
;; symlinking them.
|
||||
(if (file-is-directory? source)
|
||||
(symlink source target)
|
||||
(copy-file source target))
|
||||
|
||||
;; XXX: Dirty hack to meet sudo's expectations.
|
||||
(when (string=? (basename target) "sudoers")
|
||||
(chmod target #o440))))
|
||||
(scandir etc
|
||||
(lambda (file)
|
||||
(not (member file '("." ".."))))
|
||||
|
||||
;; The default is 'string-locale<?', but we don't have
|
||||
;; it when run from the initrd's statically-linked
|
||||
;; Guile.
|
||||
string<?))
|
||||
|
||||
;; Prevent ETC from being GC'd.
|
||||
(rm-f "/var/guix/gcroots/etc-directory")
|
||||
(symlink etc "/var/guix/gcroots/etc-directory"))
|
||||
|
||||
(define %setuid-directory
|
||||
;; Place where setuid programs are stored.
|
||||
"/run/setuid-programs")
|
||||
|
||||
(define (link-or-copy source target)
|
||||
"Attempt to make TARGET a hard link to SOURCE; if it fails, fall back to
|
||||
copy SOURCE to TARGET."
|
||||
(catch 'system-error
|
||||
(lambda ()
|
||||
(link source target))
|
||||
(lambda args
|
||||
;; Perhaps SOURCE and TARGET live in a different file system, so copy
|
||||
;; SOURCE.
|
||||
(copy-file source target))))
|
||||
|
||||
(define (activate-setuid-programs programs)
|
||||
"Turn PROGRAMS, a list of file names, into setuid programs stored under
|
||||
%SETUID-DIRECTORY."
|
||||
(define (make-setuid-program prog)
|
||||
(let ((target (string-append %setuid-directory
|
||||
"/" (basename prog))))
|
||||
(catch 'system-error
|
||||
(lambda ()
|
||||
(link prog target))
|
||||
(lambda args
|
||||
;; Perhaps PROG and TARGET live in a different file system, so copy
|
||||
;; PROG.
|
||||
(copy-file prog target)))
|
||||
(link-or-copy prog target)
|
||||
(chown target 0 0)
|
||||
(chmod target #o6555)))
|
||||
|
||||
@@ -204,6 +249,26 @@ numeric gid or #f."
|
||||
|
||||
(for-each make-setuid-program programs))
|
||||
|
||||
(define (activate-/bin/sh shell)
|
||||
"Change /bin/sh to point to SHELL."
|
||||
(symlink shell "/bin/sh.new")
|
||||
(rename-file "/bin/sh.new" "/bin/sh"))
|
||||
|
||||
(define (activate-modprobe modprobe)
|
||||
"Tell the kernel to use MODPROBE to load modules."
|
||||
(call-with-output-file "/proc/sys/kernel/modprobe"
|
||||
(lambda (port)
|
||||
(display modprobe port))))
|
||||
|
||||
(define (activate-firmware directory)
|
||||
"Tell the kernel to look for device firmware under DIRECTORY. This
|
||||
mechanism bypasses udev: it allows Linux to handle firmware loading directly
|
||||
by itself, without having to resort to a \"user helper\"."
|
||||
(call-with-output-file "/sys/module/firmware_class/parameters/path"
|
||||
(lambda (port)
|
||||
(display directory port))))
|
||||
|
||||
|
||||
(define %current-system
|
||||
;; The system that is current (a symlink.) This is not necessarily the same
|
||||
;; as the system we booted (aka. /run/booted-system) because we can re-build
|
||||
@@ -214,8 +279,13 @@ numeric gid or #f."
|
||||
"Return the '--system' argument passed on the kernel command line."
|
||||
(find-long-option "--system" (linux-command-line)))
|
||||
|
||||
(define* (activate-current-system #:optional (system (boot-time-system)))
|
||||
(define* (activate-current-system
|
||||
#:optional (system (or (getenv "GUIX_NEW_SYSTEM")
|
||||
(boot-time-system))))
|
||||
"Atomically make SYSTEM the current system."
|
||||
;; The 'GUIX_NEW_SYSTEM' environment variable is used as a way for 'guix
|
||||
;; system reconfigure' to pass the file name of the new system.
|
||||
|
||||
(format #t "making '~a' the current system...~%" system)
|
||||
|
||||
;; Atomically make SYSTEM current.
|
||||
@@ -0,0 +1,299 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2014 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/>.
|
||||
|
||||
(define-module (gnu build file-systems)
|
||||
#:use-module (guix build utils)
|
||||
#:use-module (rnrs io ports)
|
||||
#:use-module (rnrs bytevectors)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 rdelim)
|
||||
#:use-module (system foreign)
|
||||
#:autoload (system repl repl) (start-repl)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:export (disk-partitions
|
||||
partition-label-predicate
|
||||
find-partition-by-label
|
||||
canonicalize-device-spec
|
||||
|
||||
MS_RDONLY
|
||||
MS_NOSUID
|
||||
MS_NODEV
|
||||
MS_NOEXEC
|
||||
MS_BIND
|
||||
MS_MOVE
|
||||
bind-mount
|
||||
|
||||
mount-flags->bit-mask
|
||||
check-file-system
|
||||
mount-file-system))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
;;; This modules provides tools to deal with disk partitions, and to mount and
|
||||
;;; check file systems.
|
||||
;;;
|
||||
;;; Code:
|
||||
|
||||
;; Linux mount flags, from libc's <sys/mount.h>.
|
||||
(define MS_RDONLY 1)
|
||||
(define MS_NOSUID 2)
|
||||
(define MS_NODEV 4)
|
||||
(define MS_NOEXEC 8)
|
||||
(define MS_BIND 4096)
|
||||
(define MS_MOVE 8192)
|
||||
|
||||
(define (bind-mount source target)
|
||||
"Bind-mount SOURCE at TARGET."
|
||||
(mount source target "" MS_BIND))
|
||||
|
||||
(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 (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))))))
|
||||
|
||||
(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))
|
||||
|
||||
(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)
|
||||
|
||||
;; 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 (disk-partitions)
|
||||
"Return the list of device names corresponding to valid disk partitions."
|
||||
(define (partition? major minor)
|
||||
(let ((marker (format #f "/sys/dev/block/~a:~a/partition" major minor)))
|
||||
(catch 'system-error
|
||||
(lambda ()
|
||||
(not (zero? (call-with-input-file marker read))))
|
||||
(lambda args
|
||||
(if (= ENOENT (system-error-errno args))
|
||||
#f
|
||||
(apply throw args))))))
|
||||
|
||||
(call-with-input-file "/proc/partitions"
|
||||
(lambda (port)
|
||||
;; Skip the two header lines.
|
||||
(read-line port)
|
||||
(read-line port)
|
||||
|
||||
;; Read each subsequent line, and extract the last space-separated
|
||||
;; field.
|
||||
(let loop ((parts '()))
|
||||
(let ((line (read-line port)))
|
||||
(if (eof-object? line)
|
||||
(reverse parts)
|
||||
(match (string-tokenize line)
|
||||
(((= string->number major) (= string->number minor)
|
||||
blocks name)
|
||||
(if (partition? major minor)
|
||||
(loop (cons name parts))
|
||||
(loop parts))))))))))
|
||||
|
||||
(define (partition-label-predicate label)
|
||||
"Return a procedure that, when applied to a partition name such as \"sda1\",
|
||||
return #t if that partition's volume name is LABEL."
|
||||
(lambda (part)
|
||||
(let* ((device (string-append "/dev/" part))
|
||||
(sblock (catch 'system-error
|
||||
(lambda ()
|
||||
(read-ext2-superblock device))
|
||||
(lambda args
|
||||
;; When running on the hand-made /dev,
|
||||
;; 'disk-partitions' could return partitions for which
|
||||
;; we have no /dev node. Handle that gracefully.
|
||||
(if (= ENOENT (system-error-errno args))
|
||||
(begin
|
||||
(format (current-error-port)
|
||||
"warning: device '~a' not found~%"
|
||||
device)
|
||||
#f)
|
||||
(apply throw args))))))
|
||||
(and sblock
|
||||
(let ((volume (ext2-superblock-volume-name sblock)))
|
||||
(and volume
|
||||
(string=? volume label)))))))
|
||||
|
||||
(define (find-partition-by-label label)
|
||||
"Return the first partition found whose volume name is LABEL, or #f if none
|
||||
were found."
|
||||
(and=> (find (partition-label-predicate label)
|
||||
(disk-partitions))
|
||||
(cut string-append "/dev/" <>)))
|
||||
|
||||
(define* (canonicalize-device-spec spec #:optional (title 'any))
|
||||
"Return the device name corresponding to SPEC. TITLE is a symbol, one of
|
||||
the following:
|
||||
|
||||
• 'device', in which case SPEC is known to designate a device node--e.g.,
|
||||
\"/dev/sda1\";
|
||||
• 'label', in which case SPEC is known to designate a partition label--e.g.,
|
||||
\"my-root-part\";
|
||||
• 'any', in which case SPEC can be anything.
|
||||
"
|
||||
(define max-trials
|
||||
;; Number of times we retry partition label resolution, 1 second per
|
||||
;; trial. Note: somebody reported a delay of 16 seconds (!) before their
|
||||
;; USB key would be detected by the kernel, so we must wait for at least
|
||||
;; this long.
|
||||
20)
|
||||
|
||||
(define canonical-title
|
||||
;; The realm of canonicalization.
|
||||
(if (eq? title 'any)
|
||||
(if (string-prefix? "/" spec)
|
||||
'device
|
||||
'label)
|
||||
title))
|
||||
|
||||
(case canonical-title
|
||||
((device)
|
||||
;; Nothing to do.
|
||||
spec)
|
||||
((label)
|
||||
;; Resolve the label.
|
||||
(let loop ((count 0))
|
||||
(let ((device (find-partition-by-label spec)))
|
||||
(or device
|
||||
;; Some devices take a bit of time to appear, most notably USB
|
||||
;; storage devices. Thus, wait for the device to appear.
|
||||
(if (> count max-trials)
|
||||
(error "failed to resolve partition label" spec)
|
||||
(begin
|
||||
(format #t "waiting for partition '~a' to appear...~%"
|
||||
spec)
|
||||
(sleep 1)
|
||||
(loop (+ 1 count))))))))
|
||||
;; TODO: Add support for UUIDs.
|
||||
(else
|
||||
(error "unknown device title" title))))
|
||||
|
||||
(define (check-file-system device type)
|
||||
"Run a file system check of TYPE on DEVICE."
|
||||
(define fsck
|
||||
(string-append "fsck." type))
|
||||
|
||||
(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 REPL~%"
|
||||
fsck code device)
|
||||
(start-repl)))))
|
||||
|
||||
(define (mount-flags->bit-mask flags)
|
||||
"Return the number suitable for the 'flags' argument of 'mount' that
|
||||
corresponds to the symbols listed in FLAGS."
|
||||
(let loop ((flags flags))
|
||||
(match flags
|
||||
(('read-only rest ...)
|
||||
(logior MS_RDONLY (loop rest)))
|
||||
(('bind-mount rest ...)
|
||||
(logior MS_BIND (loop rest)))
|
||||
(('no-suid rest ...)
|
||||
(logior MS_NOSUID (loop rest)))
|
||||
(('no-dev rest ...)
|
||||
(logior MS_NODEV (loop rest)))
|
||||
(('no-exec rest ...)
|
||||
(logior MS_NOEXEC (loop rest)))
|
||||
(()
|
||||
0))))
|
||||
|
||||
(define* (mount-file-system spec #:key (root "/root"))
|
||||
"Mount the file system described by SPEC under ROOT. SPEC must have the
|
||||
form:
|
||||
|
||||
(DEVICE TITLE MOUNT-POINT TYPE (FLAGS ...) OPTIONS CHECK?)
|
||||
|
||||
DEVICE, MOUNT-POINT, and TYPE must be strings; OPTIONS can be a string or #f;
|
||||
FLAGS must be a list of symbols. CHECK? is a Boolean indicating whether to
|
||||
run a file system check."
|
||||
(match spec
|
||||
((source title mount-point type (flags ...) options check?)
|
||||
(let ((source (canonicalize-device-spec source title))
|
||||
(mount-point (string-append root "/" mount-point)))
|
||||
(when check?
|
||||
(check-file-system source type))
|
||||
(mkdir-p mount-point)
|
||||
(mount source mount-point type (mount-flags->bit-mask flags)
|
||||
(if options
|
||||
(string->pointer options)
|
||||
%null-pointer))
|
||||
|
||||
;; Update /etc/mtab.
|
||||
(mkdir-p (string-append root "/etc"))
|
||||
(let ((port (open-file (string-append root "/etc/mtab") "a")))
|
||||
(format port "~a ~a ~a ~a 0 0~%"
|
||||
source mount-point type (or options ""))
|
||||
(close-port port))))))
|
||||
|
||||
;;; file-systems.scm ends here
|
||||
@@ -16,9 +16,8 @@
|
||||
;;; 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 (guix build install)
|
||||
(define-module (gnu build install)
|
||||
#:use-module (guix build utils)
|
||||
#:use-module (guix build install)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (ice-9 match)
|
||||
#:export (install-grub
|
||||
@@ -57,18 +56,38 @@ MOUNT-POINT."
|
||||
"Evaluate DIRECTIVE, an sexp describing a file or directory to create under
|
||||
directory TARGET."
|
||||
(let loop ((directive directive))
|
||||
(match directive
|
||||
(('directory name)
|
||||
(mkdir-p (string-append target name)))
|
||||
(('directory name uid gid)
|
||||
(let ((dir (string-append target name)))
|
||||
(mkdir-p dir)
|
||||
(chown dir uid gid)))
|
||||
(('directory name uid gid mode)
|
||||
(loop `(directory ,name ,uid ,gid))
|
||||
(chmod (string-append target name) mode))
|
||||
((new '-> old)
|
||||
(symlink old (string-append target new))))))
|
||||
(catch 'system-error
|
||||
(lambda ()
|
||||
(match directive
|
||||
(('directory name)
|
||||
(mkdir-p (string-append target name)))
|
||||
(('directory name uid gid)
|
||||
(let ((dir (string-append target name)))
|
||||
(mkdir-p dir)
|
||||
(chown dir uid gid)))
|
||||
(('directory name uid gid mode)
|
||||
(loop `(directory ,name ,uid ,gid))
|
||||
(chmod (string-append target name) mode))
|
||||
((new '-> old)
|
||||
(let try ()
|
||||
(catch 'system-error
|
||||
(lambda ()
|
||||
(symlink old (string-append target new)))
|
||||
(lambda args
|
||||
;; When doing 'guix system init' on the current '/', some
|
||||
;; symlinks may already exists. Override them.
|
||||
(if (= EEXIST (system-error-errno args))
|
||||
(begin
|
||||
(delete-file (string-append target new))
|
||||
(try))
|
||||
(apply throw args))))))))
|
||||
(lambda args
|
||||
;; Usually we can only get here when installing to an existing root,
|
||||
;; as with 'guix system init foo.scm /'.
|
||||
(format (current-error-port)
|
||||
"error: failed to evaluate directive: ~s~%"
|
||||
directive)
|
||||
(apply throw args)))))
|
||||
|
||||
(define (directives store)
|
||||
"Return a list of directives to populate the root file system that will host
|
||||
@@ -94,7 +113,6 @@ STORE."
|
||||
("/var/guix/gcroots/current-system" -> "/run/current-system")
|
||||
|
||||
(directory "/bin")
|
||||
("/bin/sh" -> "/run/current-system/profile/bin/bash")
|
||||
(directory "/tmp" 0 0 #o1777) ; sticky bit
|
||||
|
||||
(directory "/root" 0 0) ; an exception
|
||||
@@ -107,6 +125,7 @@ includes /etc, /var, /run, /bin/sh, etc., and all the symlinks to SYSTEM."
|
||||
(directives (%store-directory)))
|
||||
|
||||
;; Add system generation 1.
|
||||
(false-if-exception (delete-file "/var/guix/profiles/system-1-link"))
|
||||
(symlink system
|
||||
(string-append target "/var/guix/profiles/system-1-link")))
|
||||
|
||||
@@ -16,35 +16,24 @@
|
||||
;;; 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 (guix build linux-initrd)
|
||||
(define-module (gnu build linux-boot)
|
||||
#:use-module (rnrs io ports)
|
||||
#:use-module (rnrs bytevectors)
|
||||
#:use-module (system foreign)
|
||||
#:use-module (system repl error-handling)
|
||||
#:autoload (system repl repl) (start-repl)
|
||||
#:autoload (system base compile) (compile-file)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 rdelim)
|
||||
#:use-module (ice-9 ftw)
|
||||
#:use-module (guix build utils)
|
||||
#:use-module (gnu build file-systems)
|
||||
#:export (mount-essential-file-systems
|
||||
linux-command-line
|
||||
find-long-option
|
||||
make-essential-device-nodes
|
||||
configure-qemu-networking
|
||||
|
||||
disk-partitions
|
||||
partition-label-predicate
|
||||
find-partition-by-label
|
||||
canonicalize-device-spec
|
||||
|
||||
mount-flags->bit-mask
|
||||
check-file-system
|
||||
mount-file-system
|
||||
bind-mount
|
||||
|
||||
load-linux-module*
|
||||
device-number
|
||||
boot-system))
|
||||
@@ -99,173 +88,12 @@ Return the value associated with OPTION, or #f on failure."
|
||||
(lambda (arg)
|
||||
(substring arg (+ 1 (string-index arg #\=)))))))
|
||||
|
||||
(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 (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))))))
|
||||
|
||||
(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))
|
||||
|
||||
(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)
|
||||
|
||||
;; 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 (disk-partitions)
|
||||
"Return the list of device names corresponding to valid disk partitions."
|
||||
(define (partition? major minor)
|
||||
(let ((marker (format #f "/sys/dev/block/~a:~a/partition" major minor)))
|
||||
(catch 'system-error
|
||||
(lambda ()
|
||||
(not (zero? (call-with-input-file marker read))))
|
||||
(lambda args
|
||||
(if (= ENOENT (system-error-errno args))
|
||||
#f
|
||||
(apply throw args))))))
|
||||
|
||||
(call-with-input-file "/proc/partitions"
|
||||
(lambda (port)
|
||||
;; Skip the two header lines.
|
||||
(read-line port)
|
||||
(read-line port)
|
||||
|
||||
;; Read each subsequent line, and extract the last space-separated
|
||||
;; field.
|
||||
(let loop ((parts '()))
|
||||
(let ((line (read-line port)))
|
||||
(if (eof-object? line)
|
||||
(reverse parts)
|
||||
(match (string-tokenize line)
|
||||
(((= string->number major) (= string->number minor)
|
||||
blocks name)
|
||||
(if (partition? major minor)
|
||||
(loop (cons name parts))
|
||||
(loop parts))))))))))
|
||||
|
||||
(define (partition-label-predicate label)
|
||||
"Return a procedure that, when applied to a partition name such as \"sda1\",
|
||||
return #t if that partition's volume name is LABEL."
|
||||
(lambda (part)
|
||||
(let* ((device (string-append "/dev/" part))
|
||||
(sblock (catch 'system-error
|
||||
(lambda ()
|
||||
(read-ext2-superblock device))
|
||||
(lambda args
|
||||
;; When running on the hand-made /dev,
|
||||
;; 'disk-partitions' could return partitions for which
|
||||
;; we have no /dev node. Handle that gracefully.
|
||||
(if (= ENOENT (system-error-errno args))
|
||||
(begin
|
||||
(format (current-error-port)
|
||||
"warning: device '~a' not found~%"
|
||||
device)
|
||||
#f)
|
||||
(apply throw args))))))
|
||||
(and sblock
|
||||
(let ((volume (ext2-superblock-volume-name sblock)))
|
||||
(and volume
|
||||
(string=? volume label)))))))
|
||||
|
||||
(define (find-partition-by-label label)
|
||||
"Return the first partition found whose volume name is LABEL, or #f if none
|
||||
were found."
|
||||
(and=> (find (partition-label-predicate label)
|
||||
(disk-partitions))
|
||||
(cut string-append "/dev/" <>)))
|
||||
|
||||
(define* (canonicalize-device-spec spec #:optional (title 'any))
|
||||
"Return the device name corresponding to SPEC. TITLE is a symbol, one of
|
||||
the following:
|
||||
|
||||
• 'device', in which case SPEC is known to designate a device node--e.g.,
|
||||
\"/dev/sda1\";
|
||||
• 'label', in which case SPEC is known to designate a partition label--e.g.,
|
||||
\"my-root-part\";
|
||||
• 'any', in which case SPEC can be anything.
|
||||
"
|
||||
(define max-trials
|
||||
;; Number of times we retry partition label resolution.
|
||||
7)
|
||||
|
||||
(define canonical-title
|
||||
;; The realm of canonicalization.
|
||||
(if (eq? title 'any)
|
||||
(if (string-prefix? "/" spec)
|
||||
'device
|
||||
'label)
|
||||
title))
|
||||
|
||||
(case canonical-title
|
||||
((device)
|
||||
;; Nothing to do.
|
||||
spec)
|
||||
((label)
|
||||
;; Resolve the label.
|
||||
(let loop ((count 0))
|
||||
(let ((device (find-partition-by-label spec)))
|
||||
(or device
|
||||
;; Some devices take a bit of time to appear, most notably USB
|
||||
;; storage devices. Thus, wait for the device to appear.
|
||||
(if (> count max-trials)
|
||||
(error "failed to resolve partition label" spec)
|
||||
(begin
|
||||
(sleep 1)
|
||||
(loop (+ 1 count))))))))
|
||||
;; TODO: Add support for UUIDs.
|
||||
(else
|
||||
(error "unknown device title" title))))
|
||||
|
||||
(define* (make-disk-device-nodes base major #:optional (minor 0))
|
||||
"Make the block device nodes around BASE (something like \"/root/dev/sda\")
|
||||
with the given MAJOR number, starting with MINOR."
|
||||
(mknod base 'block-special #o644 (device-number major minor))
|
||||
(let loop ((i 1))
|
||||
(when (< i 6)
|
||||
(when (< i 16)
|
||||
(mknod (string-append base (number->string i))
|
||||
'block-special #o644 (device-number major (+ minor i)))
|
||||
(loop (+ i 1)))))
|
||||
@@ -384,29 +212,16 @@ networking values.) Return #t if INTERFACE is up, #f otherwise."
|
||||
(set-network-interface-address sock interface address)
|
||||
(set-network-interface-flags sock interface (logior flags IFF_UP))
|
||||
|
||||
(unless (file-exists? "/etc")
|
||||
(mkdir "/etc"))
|
||||
(call-with-output-file "/etc/resolv.conf"
|
||||
(lambda (p)
|
||||
(display "nameserver 10.0.2.3\n" p)))
|
||||
;; Hello! We used to create /etc/resolv.conf here, with "nameserver
|
||||
;; 10.0.2.3\n". However, with Linux-libre 3.16, we're getting ENOSPC.
|
||||
;; And since it's actually unnecessary, it's gone.
|
||||
|
||||
(logand (network-interface-flags sock interface) IFF_UP)))
|
||||
|
||||
;; Linux mount flags, from libc's <sys/mount.h>.
|
||||
(define MS_RDONLY 1)
|
||||
(define MS_NOSUID 2)
|
||||
(define MS_NODEV 4)
|
||||
(define MS_NOEXEC 8)
|
||||
(define MS_BIND 4096)
|
||||
(define MS_MOVE 8192)
|
||||
|
||||
(define (bind-mount source target)
|
||||
"Bind-mount SOURCE at TARGET."
|
||||
(mount source target "" MS_BIND))
|
||||
|
||||
(define (load-linux-module* file)
|
||||
"Load Linux module from FILE, the name of a `.ko' file."
|
||||
(define (slurp module)
|
||||
;; TODO: Use 'mmap' to reduce memory usage.
|
||||
(call-with-input-file file get-bytevector-all))
|
||||
|
||||
(load-linux-module (slurp file)))
|
||||
@@ -476,74 +291,6 @@ UNIONFS."
|
||||
|
||||
(copy-file "/proc/mounts" "/root/etc/mtab"))
|
||||
|
||||
(define (check-file-system device type)
|
||||
"Run a file system check of TYPE on DEVICE."
|
||||
(define fsck
|
||||
(string-append "fsck." type))
|
||||
|
||||
(let ((status (system* fsck "-v" "-p" 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 REPL~%"
|
||||
fsck code device)
|
||||
(start-repl)))))
|
||||
|
||||
(define (mount-flags->bit-mask flags)
|
||||
"Return the number suitable for the 'flags' argument of 'mount' that
|
||||
corresponds to the symbols listed in FLAGS."
|
||||
(let loop ((flags flags))
|
||||
(match flags
|
||||
(('read-only rest ...)
|
||||
(logior MS_RDONLY (loop rest)))
|
||||
(('bind-mount rest ...)
|
||||
(logior MS_BIND (loop rest)))
|
||||
(('no-suid rest ...)
|
||||
(logior MS_NOSUID (loop rest)))
|
||||
(('no-dev rest ...)
|
||||
(logior MS_NODEV (loop rest)))
|
||||
(('no-exec rest ...)
|
||||
(logior MS_NOEXEC (loop rest)))
|
||||
(()
|
||||
0))))
|
||||
|
||||
(define* (mount-file-system spec #:key (root "/root"))
|
||||
"Mount the file system described by SPEC under ROOT. SPEC must have the
|
||||
form:
|
||||
|
||||
(DEVICE TITLE MOUNT-POINT TYPE (FLAGS ...) OPTIONS CHECK?)
|
||||
|
||||
DEVICE, MOUNT-POINT, and TYPE must be strings; OPTIONS can be a string or #f;
|
||||
FLAGS must be a list of symbols. CHECK? is a Boolean indicating whether to
|
||||
run a file system check."
|
||||
(match spec
|
||||
((source title mount-point type (flags ...) options check?)
|
||||
(let ((source (canonicalize-device-spec source title))
|
||||
(mount-point (string-append root "/" mount-point)))
|
||||
(when check?
|
||||
(check-file-system source type))
|
||||
(mkdir-p mount-point)
|
||||
(mount source mount-point type (mount-flags->bit-mask flags)
|
||||
(if options
|
||||
(string->pointer options)
|
||||
%null-pointer))
|
||||
|
||||
;; Update /etc/mtab.
|
||||
(mkdir-p (string-append root "/etc"))
|
||||
(let ((port (open-file (string-append root "/etc/mtab") "a")))
|
||||
(format port "~a ~a ~a ~a 0 0~%"
|
||||
source mount-point type (or options ""))
|
||||
(close-port port))))))
|
||||
|
||||
(define (switch-root root)
|
||||
"Switch to ROOT as the root file system, in a way similar to what
|
||||
util-linux' switch_root(8) does."
|
||||
@@ -592,23 +339,21 @@ bailing out.~%root contents: ~s~%" (scandir "/"))
|
||||
(define* (boot-system #:key
|
||||
(linux-modules '())
|
||||
qemu-guest-networking?
|
||||
guile-modules-in-chroot?
|
||||
volatile-root?
|
||||
pre-mount
|
||||
(mounts '()))
|
||||
"This procedure is meant to be called from an initrd. Boot a system by
|
||||
first loading LINUX-MODULES, then setting up QEMU guest networking if
|
||||
QEMU-GUEST-NETWORKING? is true, mounting the file systems specified in MOUNTS,
|
||||
and finally booting into the new root if any. The initrd supports kernel
|
||||
command-line options '--load', '--root', and '--repl'.
|
||||
first loading LINUX-MODULES (a list of absolute file names of '.ko' files),
|
||||
then setting up QEMU guest networking if QEMU-GUEST-NETWORKING? is true,
|
||||
calling PRE-MOUNT, mounting the file systems specified in MOUNTS, and finally
|
||||
booting into the new root if any. The initrd supports kernel command-line
|
||||
options '--load', '--root', and '--repl'.
|
||||
|
||||
Mount the root file system, specified by the '--root' command-line argument,
|
||||
if any.
|
||||
|
||||
MOUNTS must be a list suitable for 'mount-file-system'.
|
||||
|
||||
When GUILE-MODULES-IN-CHROOT? is true, make core Guile modules available in
|
||||
the new root.
|
||||
|
||||
When VOLATILE-ROOT? is true, the root file system is writable but any changes
|
||||
to it are lost."
|
||||
(define root-mount-point?
|
||||
@@ -637,9 +382,7 @@ to it are lost."
|
||||
(start-repl))
|
||||
|
||||
(display "loading kernel modules...\n")
|
||||
(for-each (compose load-linux-module*
|
||||
(cut string-append "/modules/" <>))
|
||||
linux-modules)
|
||||
(for-each load-linux-module* linux-modules)
|
||||
|
||||
(when qemu-guest-networking?
|
||||
(unless (configure-qemu-networking)
|
||||
@@ -661,23 +404,15 @@ to it are lost."
|
||||
(mkdir "/root/dev")
|
||||
(make-essential-device-nodes #:root "/root"))
|
||||
|
||||
(when (procedure? pre-mount)
|
||||
;; Do whatever actions are needed before mounting--e.g., installing
|
||||
;; device mappings.
|
||||
(pre-mount))
|
||||
|
||||
;; Mount the specified file systems.
|
||||
(for-each mount-file-system
|
||||
(remove root-mount-point? mounts))
|
||||
|
||||
(when guile-modules-in-chroot?
|
||||
;; Copy the directories that contain .scm and .go files so that the
|
||||
;; child process in the chroot can load modules (we would bind-mount
|
||||
;; them but for some reason that fails with EINVAL -- XXX).
|
||||
(mkdir-p "/root/share")
|
||||
(mkdir-p "/root/lib")
|
||||
(mount "none" "/root/share" "tmpfs")
|
||||
(mount "none" "/root/lib" "tmpfs")
|
||||
(copy-recursively "/share" "/root/share"
|
||||
#:log (%make-void-port "w"))
|
||||
(copy-recursively "/lib" "/root/lib"
|
||||
#:log (%make-void-port "w")))
|
||||
|
||||
(if to-load
|
||||
(begin
|
||||
(switch-root "/root")
|
||||
@@ -0,0 +1,142 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2013, 2014 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/>.
|
||||
|
||||
(define-module (gnu build linux-initrd)
|
||||
#:use-module (guix build utils)
|
||||
#:use-module (guix build store-copy)
|
||||
#:use-module (system base compile)
|
||||
#:use-module (rnrs bytevectors)
|
||||
#:use-module ((system foreign) #:select (sizeof))
|
||||
#:use-module (ice-9 popen)
|
||||
#:use-module (ice-9 ftw)
|
||||
#:export (write-cpio-archive
|
||||
build-initrd))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
;;; Tools to create Linux initial RAM disks ("initrds"). Initrds are
|
||||
;;; essentially gzipped cpio archives, with a '/init' executable that the
|
||||
;;; kernel runs at boot time.
|
||||
;;;
|
||||
;;; Code:
|
||||
|
||||
(define* (write-cpio-archive output directory
|
||||
#:key
|
||||
(compress? #t)
|
||||
(cpio "cpio") (gzip "gzip"))
|
||||
"Write a cpio archive containing DIRECTORY to file OUTPUT, using CPIO. When
|
||||
COMPRESS? is true, compress it using GZIP. On success, return OUTPUT."
|
||||
|
||||
;; Note: don't use '--no-absolute-filenames' since that strips leading
|
||||
;; slashes from symlink targets.
|
||||
(let ((pipe (open-pipe* OPEN_WRITE cpio "-o" "-O" output
|
||||
"-H" "newc" "--null")))
|
||||
(define (print0 file)
|
||||
(format pipe "~a\0" file))
|
||||
|
||||
;; Note: as per `ramfs-rootfs-initramfs.txt', always add directory entries
|
||||
;; before the files that are inside of it: "The Linux kernel cpio
|
||||
;; extractor won't create files in a directory that doesn't exist, so the
|
||||
;; directory entries must go before the files that go in those
|
||||
;; directories."
|
||||
|
||||
;; XXX: Use a deterministic order.
|
||||
(file-system-fold (const #t)
|
||||
(lambda (file stat result) ; leaf
|
||||
(print0 file))
|
||||
(lambda (dir stat result) ; down
|
||||
(unless (string=? dir directory)
|
||||
(print0 dir)))
|
||||
(const #f) ; up
|
||||
(const #f) ; skip
|
||||
(const #f)
|
||||
#f
|
||||
directory)
|
||||
|
||||
(and (zero? (close-pipe pipe))
|
||||
(or (not compress?)
|
||||
(and (zero? (system* gzip "--best" output))
|
||||
(rename-file (string-append output ".gz")
|
||||
output))
|
||||
output))))
|
||||
|
||||
(define (cache-compiled-file-name file)
|
||||
"Return the file name of the in-cache .go file for FILE, relative to the
|
||||
current directory.
|
||||
|
||||
This is similar to what 'compiled-file-name' in (system base compile) does."
|
||||
(let loop ((file file))
|
||||
(let ((target (false-if-exception (readlink file))))
|
||||
(if target
|
||||
(loop target)
|
||||
(format #f ".cache/guile/ccache/~a-~a-~a-~a/~a"
|
||||
(effective-version)
|
||||
(if (eq? (native-endianness) (endianness little))
|
||||
"LE"
|
||||
"BE")
|
||||
(sizeof '*)
|
||||
(effective-version)
|
||||
file)))))
|
||||
|
||||
(define (compile-to-cache file)
|
||||
"Compile FILE to the cache."
|
||||
(let ((compiled-file (cache-compiled-file-name file)))
|
||||
(mkdir-p (dirname compiled-file))
|
||||
(compile-file file
|
||||
#:opts %auto-compilation-options
|
||||
#:output-file compiled-file)))
|
||||
|
||||
(define* (build-initrd output
|
||||
#:key
|
||||
guile init
|
||||
(references-graphs '())
|
||||
(cpio "cpio")
|
||||
(gzip "gzip"))
|
||||
"Write an initial RAM disk (initrd) to OUTPUT. The initrd starts the script
|
||||
at INIT, running GUILE. It contains all the items referred to by
|
||||
REFERENCES-GRAPHS."
|
||||
(mkdir "contents")
|
||||
|
||||
;; Copy the closures of all the items referenced in REFERENCES-GRAPHS.
|
||||
(populate-store references-graphs "contents")
|
||||
|
||||
(with-directory-excursion "contents"
|
||||
;; Make '/init'.
|
||||
(symlink init "init")
|
||||
|
||||
;; Compile it.
|
||||
(compile-to-cache "init")
|
||||
|
||||
;; Allow Guile to find out where it is (XXX). See
|
||||
;; 'guile-relocatable.patch'.
|
||||
(mkdir-p "proc/self")
|
||||
(symlink (string-append guile "/bin/guile") "proc/self/exe")
|
||||
(readlink "proc/self/exe")
|
||||
|
||||
;; Reset the timestamps of all the files that will make it in the initrd.
|
||||
(for-each (lambda (file)
|
||||
(unless (eq? 'symlink (stat:type (lstat file)))
|
||||
(utime file 0 0 0 0)))
|
||||
(find-files "." ".*"))
|
||||
|
||||
(write-cpio-archive output "."
|
||||
#:cpio cpio #:gzip gzip))
|
||||
|
||||
(delete-file-recursively "contents"))
|
||||
|
||||
;;; linux-initrd.scm ends here
|
||||
@@ -16,14 +16,13 @@
|
||||
;;; 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 (guix build vm)
|
||||
(define-module (gnu build vm)
|
||||
#:use-module (guix build utils)
|
||||
#:use-module (guix build linux-initrd)
|
||||
#:use-module (guix build install)
|
||||
#:use-module (guix build store-copy)
|
||||
#:use-module (gnu build linux-boot)
|
||||
#:use-module (gnu build install)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 regex)
|
||||
#:use-module (ice-9 rdelim)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:export (qemu-command
|
||||
load-in-linux-vm
|
||||
@@ -111,55 +110,25 @@ the #:references-graphs parameter of 'derivation'."
|
||||
(mkdir output)
|
||||
(copy-recursively "xchg" output))))
|
||||
|
||||
(define (read-reference-graph port)
|
||||
"Return a list of store paths from the reference graph at PORT.
|
||||
The data at PORT is the format produced by #:references-graphs."
|
||||
(let loop ((line (read-line port))
|
||||
(result '()))
|
||||
(cond ((eof-object? line)
|
||||
(delete-duplicates result))
|
||||
((string-prefix? "/" line)
|
||||
(loop (read-line port)
|
||||
(cons line result)))
|
||||
(else
|
||||
(loop (read-line port)
|
||||
result)))))
|
||||
|
||||
(define* (initialize-partition-table device partition-size
|
||||
#:key
|
||||
bootable?
|
||||
(label-type "msdos")
|
||||
(offset (expt 2 20)))
|
||||
"Create on DEVICE a partition table of type LABEL-TYPE, with a single
|
||||
partition of PARTITION-SIZE bytes starting at OFFSET bytes. Return #t on
|
||||
success."
|
||||
partition of PARTITION-SIZE bytes starting at OFFSET bytes. When BOOTABLE? is
|
||||
true, set the bootable flag on the partition. Return #t on success."
|
||||
(format #t "creating partition table with a ~a B partition...\n"
|
||||
partition-size)
|
||||
(unless (zero? (system* "parted" device "mklabel" label-type
|
||||
"mkpart" "primary" "ext2"
|
||||
(format #f "~aB" offset)
|
||||
(format #f "~aB" partition-size)))
|
||||
(unless (zero? (apply system* "parted" device "mklabel" label-type
|
||||
"mkpart" "primary" "ext2"
|
||||
(format #f "~aB" offset)
|
||||
(format #f "~aB" partition-size)
|
||||
(if bootable?
|
||||
'("set" "1" "boot" "on")
|
||||
'())))
|
||||
(error "failed to create partition table")))
|
||||
|
||||
(define* (populate-store reference-graphs target)
|
||||
"Populate the store under directory TARGET with the items specified in
|
||||
REFERENCE-GRAPHS, a list of reference-graph files."
|
||||
(define store
|
||||
(string-append target (%store-directory)))
|
||||
|
||||
(define (things-to-copy)
|
||||
;; Return the list of store files to copy to the image.
|
||||
(define (graph-from-file file)
|
||||
(call-with-input-file file read-reference-graph))
|
||||
|
||||
(delete-duplicates (append-map graph-from-file reference-graphs)))
|
||||
|
||||
(mkdir-p store)
|
||||
(chmod store #o1775)
|
||||
(for-each (lambda (thing)
|
||||
(copy-recursively thing
|
||||
(string-append target thing)))
|
||||
(things-to-copy)))
|
||||
|
||||
(define MS_BIND 4096) ; <sys/mounts.h> again!
|
||||
|
||||
(define* (format-partition partition type
|
||||
@@ -218,13 +187,16 @@ volume name."
|
||||
file-system-label
|
||||
(closures '())
|
||||
copy-closures?
|
||||
(bootable? #t)
|
||||
(register-closures? #t))
|
||||
"Initialize DEVICE, a disk of DISK-IMAGE-SIZE bytes, with a FILE-SYSTEM-TYPE
|
||||
partition with (optionally) FILE-SYSTEM-LABEL as its volume name, and with
|
||||
GRUB installed. If REGISTER-CLOSURES? is true, register all of CLOSURES is
|
||||
the partition's store. If COPY-CLOSURES? is true, copy all of CLOSURES to the
|
||||
partition. SYSTEM-DIRECTORY is the name of the directory of the 'system'
|
||||
derivation."
|
||||
GRUB installed. When BOOTABLE? is true, set the bootable flag on that
|
||||
partition.
|
||||
|
||||
If REGISTER-CLOSURES? is true, register all of CLOSURES is the partition's
|
||||
store. If COPY-CLOSURES? is true, copy all of CLOSURES to the partition.
|
||||
SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation."
|
||||
(define target-directory
|
||||
"/fs")
|
||||
|
||||
@@ -232,7 +204,8 @@ derivation."
|
||||
(string-append device "1"))
|
||||
|
||||
(initialize-partition-table device
|
||||
(- disk-image-size (* 5 (expt 2 20))))
|
||||
(- disk-image-size (* 5 (expt 2 20)))
|
||||
#:bootable? bootable?)
|
||||
|
||||
(format-partition partition file-system-type
|
||||
#:label file-system-label)
|
||||
+182
-42
@@ -1,5 +1,5 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
|
||||
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
|
||||
;;;
|
||||
@@ -22,16 +22,20 @@
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix ui)
|
||||
#:use-module (guix utils)
|
||||
#:use-module ((guix ftp-client) #:select (ftp-open))
|
||||
#:use-module (guix gnu-maintenance)
|
||||
#:use-module (ice-9 ftw)
|
||||
#:use-module (ice-9 vlist)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-11)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (srfi srfi-39)
|
||||
#:export (search-patch
|
||||
search-bootstrap-binary
|
||||
%patch-directory
|
||||
%bootstrap-binaries-path
|
||||
%package-module-path
|
||||
|
||||
fold-packages
|
||||
|
||||
@@ -41,7 +45,11 @@
|
||||
|
||||
package-direct-dependents
|
||||
package-transitive-dependents
|
||||
package-covering-dependents))
|
||||
package-covering-dependents
|
||||
|
||||
check-package-freshness
|
||||
|
||||
specification->package))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
@@ -50,8 +58,6 @@
|
||||
;;;
|
||||
;;; Code:
|
||||
|
||||
(define _ (cut gettext <> "guix"))
|
||||
|
||||
;; By default, we store patches and bootstrap binaries alongside Guile
|
||||
;; modules. This is so that these extra files can be found without
|
||||
;; requiring a special setup, such as a specific installation directory
|
||||
@@ -60,7 +66,7 @@
|
||||
|
||||
(define %patch-path
|
||||
(make-parameter
|
||||
(map (cut string-append <> "/gnu/packages/patches")
|
||||
(map (cut string-append <> "/gnu/packages/patches")
|
||||
%load-path)))
|
||||
|
||||
(define %bootstrap-binaries-path
|
||||
@@ -77,21 +83,33 @@
|
||||
(search-path (%bootstrap-binaries-path)
|
||||
(string-append system "/" file-name)))
|
||||
|
||||
(define %distro-module-directory
|
||||
;; Absolute path of the (gnu packages ...) module root.
|
||||
(string-append (dirname (search-path %load-path "gnu/packages.scm"))
|
||||
"/packages"))
|
||||
(define %distro-root-directory
|
||||
;; Absolute file name of the module hierarchy.
|
||||
(dirname (search-path %load-path "guix.scm")))
|
||||
|
||||
(define (package-files)
|
||||
"Return the list of files that implement distro modules."
|
||||
(define prefix-len
|
||||
(string-length
|
||||
(dirname (dirname (search-path %load-path "gnu/packages.scm")))))
|
||||
(define %package-module-path
|
||||
;; Search path for package modules. Each item must be either a directory
|
||||
;; name or a pair whose car is a directory and whose cdr is a sub-directory
|
||||
;; to narrow the search.
|
||||
(let* ((not-colon (char-set-complement (char-set #\:)))
|
||||
(environment (string-tokenize (or (getenv "GUIX_PACKAGE_PATH") "")
|
||||
not-colon)))
|
||||
;; Automatically add items from $GUIX_PACKAGE_PATH to Guile's search path.
|
||||
(for-each (lambda (directory)
|
||||
(set! %load-path (cons directory %load-path))
|
||||
(set! %load-compiled-path
|
||||
(cons directory %load-compiled-path)))
|
||||
environment)
|
||||
|
||||
(make-parameter
|
||||
(append environment `((,%distro-root-directory . "gnu/packages"))))))
|
||||
|
||||
(define* (scheme-files directory)
|
||||
"Return the list of Scheme files found under DIRECTORY."
|
||||
(file-system-fold (const #t) ; enter?
|
||||
(lambda (path stat result) ; leaf
|
||||
(if (string-suffix? ".scm" path)
|
||||
(cons (substring path prefix-len) result)
|
||||
(cons path result)
|
||||
result))
|
||||
(lambda (path stat result) ; down
|
||||
result)
|
||||
@@ -103,20 +121,42 @@
|
||||
path (strerror errno))
|
||||
result)
|
||||
'()
|
||||
%distro-module-directory
|
||||
directory
|
||||
stat))
|
||||
|
||||
(define (package-modules)
|
||||
"Return the list of modules that provide packages for the distribution."
|
||||
(define not-slash
|
||||
(char-set-complement (char-set #\/)))
|
||||
(define file-name->module-name
|
||||
(let ((not-slash (char-set-complement (char-set #\/))))
|
||||
(lambda (file)
|
||||
"Return the module name (a list of symbols) corresponding to FILE."
|
||||
(map string->symbol
|
||||
(string-tokenize (string-drop-right file 4) not-slash)))))
|
||||
|
||||
(filter-map (lambda (path)
|
||||
(let ((name (map string->symbol
|
||||
(string-tokenize (string-drop-right path 4)
|
||||
not-slash))))
|
||||
(false-if-exception (resolve-interface name))))
|
||||
(package-files)))
|
||||
(define* (package-modules directory #:optional sub-directory)
|
||||
"Return the list of modules that provide packages for the distribution.
|
||||
Optionally, narrow the search to SUB-DIRECTORY."
|
||||
(define prefix-len
|
||||
(string-length directory))
|
||||
|
||||
(filter-map (lambda (file)
|
||||
(let ((file (substring file prefix-len)))
|
||||
(false-if-exception
|
||||
(resolve-interface (file-name->module-name file)))))
|
||||
(scheme-files (if sub-directory
|
||||
(string-append directory "/" sub-directory)
|
||||
directory))))
|
||||
|
||||
(define* (all-package-modules #:optional (path (%package-module-path)))
|
||||
"Return the list of package modules found in PATH, a list of directories to
|
||||
search."
|
||||
(fold-right (lambda (spec result)
|
||||
(match spec
|
||||
((? string? directory)
|
||||
(append (package-modules directory) result))
|
||||
((directory . sub-directory)
|
||||
(append (package-modules directory sub-directory)
|
||||
result))))
|
||||
'()
|
||||
path))
|
||||
|
||||
(define (fold-packages proc init)
|
||||
"Call (PROC PACKAGE RESULT) for each available package, using INIT as
|
||||
@@ -137,24 +177,22 @@ same package twice."
|
||||
module)))
|
||||
init
|
||||
vlist-null
|
||||
(package-modules))))
|
||||
(all-package-modules))))
|
||||
|
||||
(define* (find-packages-by-name name #:optional version)
|
||||
"Return the list of packages with the given NAME. If VERSION is not #f,
|
||||
(define find-packages-by-name
|
||||
(let ((packages (delay
|
||||
(fold-packages (lambda (p r)
|
||||
(vhash-cons (package-name p) p r))
|
||||
vlist-null))))
|
||||
(lambda* (name #:optional version)
|
||||
"Return the list of packages with the given NAME. If VERSION is not #f,
|
||||
then only return packages whose version is equal to VERSION."
|
||||
(define right-package?
|
||||
(if version
|
||||
(lambda (p)
|
||||
(and (string=? (package-name p) name)
|
||||
(string=? (package-version p) version)))
|
||||
(lambda (p)
|
||||
(string=? (package-name p) name))))
|
||||
|
||||
(fold-packages (lambda (package result)
|
||||
(if (right-package? package)
|
||||
(cons package result)
|
||||
result))
|
||||
'()))
|
||||
(let ((matching (vhash-fold* cons '() name (force packages))))
|
||||
(if version
|
||||
(filter (lambda (package)
|
||||
(string=? (package-version package) version))
|
||||
matching)
|
||||
matching)))))
|
||||
|
||||
(define find-newest-available-packages
|
||||
(memoize
|
||||
@@ -246,3 +284,105 @@ include all of PACKAGES and all packages that depend on PACKAGES."
|
||||
(lambda (node) (vhash-refq dependency-dag node))
|
||||
;; Start with the dependents to avoid including PACKAGES in the result.
|
||||
(package-direct-dependents packages))))
|
||||
|
||||
|
||||
(define %sigint-prompt
|
||||
;; The prompt to jump to upon SIGINT.
|
||||
(make-prompt-tag "interruptible"))
|
||||
|
||||
(define (call-with-sigint-handler thunk handler)
|
||||
"Call THUNK and return its value. Upon SIGINT, call HANDLER with the signal
|
||||
number in the context of the continuation of the call to this function, and
|
||||
return its return value."
|
||||
(call-with-prompt %sigint-prompt
|
||||
(lambda ()
|
||||
(sigaction SIGINT
|
||||
(lambda (signum)
|
||||
(sigaction SIGINT SIG_DFL)
|
||||
(abort-to-prompt %sigint-prompt signum)))
|
||||
(dynamic-wind
|
||||
(const #t)
|
||||
thunk
|
||||
(cut sigaction SIGINT SIG_DFL)))
|
||||
(lambda (k signum)
|
||||
(handler signum))))
|
||||
|
||||
(define-syntax-rule (waiting exp fmt rest ...)
|
||||
"Display the given message while EXP is being evaluated."
|
||||
(let* ((message (format #f fmt rest ...))
|
||||
(blank (make-string (string-length message) #\space)))
|
||||
(display message (current-error-port))
|
||||
(force-output (current-error-port))
|
||||
(call-with-sigint-handler
|
||||
(lambda ()
|
||||
(dynamic-wind
|
||||
(const #f)
|
||||
(lambda () exp)
|
||||
(lambda ()
|
||||
;; Clear the line.
|
||||
(display #\cr (current-error-port))
|
||||
(display blank (current-error-port))
|
||||
(display #\cr (current-error-port))
|
||||
(force-output (current-error-port)))))
|
||||
(lambda (signum)
|
||||
(format (current-error-port) " interrupted by signal ~a~%" SIGINT)
|
||||
#f))))
|
||||
|
||||
(define ftp-open*
|
||||
;; Memoizing version of `ftp-open'. The goal is to avoid initiating a new
|
||||
;; FTP connection for each package, esp. since most of them are to the same
|
||||
;; server. This has a noticeable impact when doing "guix upgrade -u".
|
||||
(memoize ftp-open))
|
||||
|
||||
(define (check-package-freshness package)
|
||||
"Check whether PACKAGE has a newer version available upstream, and report
|
||||
it."
|
||||
;; TODO: Automatically inject the upstream version when desired.
|
||||
|
||||
(catch #t
|
||||
(lambda ()
|
||||
(when (false-if-exception (gnu-package? package))
|
||||
(let ((name (package-name package))
|
||||
(full-name (package-full-name package)))
|
||||
(match (waiting (latest-release name
|
||||
#:ftp-open ftp-open*
|
||||
#:ftp-close (const #f))
|
||||
(_ "looking for the latest release of GNU ~a...") name)
|
||||
((? gnu-release? release)
|
||||
(let ((latest-version
|
||||
(string-append (gnu-release-package release) "-"
|
||||
(gnu-release-version release))))
|
||||
(when (version>? latest-version full-name)
|
||||
(format (current-error-port)
|
||||
(_ "~a: note: using ~a \
|
||||
but ~a is available upstream~%")
|
||||
(location->string (package-location package))
|
||||
full-name latest-version))))
|
||||
(_ #t)))))
|
||||
(lambda (key . args)
|
||||
;; Silently ignore networking errors rather than preventing
|
||||
;; installation.
|
||||
(case key
|
||||
((getaddrinfo-error ftp-error) #f)
|
||||
(else (apply throw key args))))))
|
||||
|
||||
(define (specification->package spec)
|
||||
"Return a package matching SPEC. SPEC may be a package name, or a package
|
||||
name followed by a hyphen and a version number. If the version number is not
|
||||
present, return the preferred newest version."
|
||||
(let-values (((name version)
|
||||
(package-name->name+version spec)))
|
||||
(match (find-best-packages-by-name name version)
|
||||
((p) ; one match
|
||||
p)
|
||||
((p x ...) ; several matches
|
||||
(warning (_ "ambiguous package specification `~a'~%") spec)
|
||||
(warning (_ "choosing ~a from ~a~%")
|
||||
(package-full-name p)
|
||||
(location->string (package-location p)))
|
||||
p)
|
||||
(_ ; no matches
|
||||
(if version
|
||||
(leave (_ "~A: package not found for version ~a~%")
|
||||
name version)
|
||||
(leave (_ "~A: unknown package~%") name))))))
|
||||
|
||||
@@ -0,0 +1,106 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2014 Marek Benc <merkur32@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/>.
|
||||
|
||||
(define-module (gnu packages abiword)
|
||||
#:use-module ((guix licenses) #:prefix license:)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (gnu packages)
|
||||
#:use-module (gnu packages boost)
|
||||
#:use-module (gnu packages compression)
|
||||
#:use-module (gnu packages enchant)
|
||||
#:use-module (gnu packages fribidi)
|
||||
#:use-module (gnu packages fontutils)
|
||||
#:use-module (gnu packages glib)
|
||||
#:use-module (gnu packages gnome)
|
||||
#:use-module (gnu packages gtk)
|
||||
#:use-module (gnu packages image)
|
||||
#:use-module (gnu packages ots)
|
||||
#:use-module (gnu packages popt)
|
||||
#:use-module (gnu packages pkg-config)
|
||||
#:use-module (gnu packages readline)
|
||||
#:use-module (gnu packages wv)
|
||||
#:use-module (gnu packages xml))
|
||||
|
||||
(define-public abiword
|
||||
(package
|
||||
(name "abiword")
|
||||
(version "2.8.6")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri
|
||||
(string-append "http://abisource.org/downloads/" name "/" version
|
||||
"/source/" name "-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32 "059sd2apxdmcacc4pll880i7vm18h0kyjsq299m1mz3c7ak8k46r"))
|
||||
(patches
|
||||
(list
|
||||
(search-patch "abiword-wmf-version-lookup-fix.patch")
|
||||
(search-patch "abiword-no-include-glib-internal-headers.patch")
|
||||
(search-patch "abiword-explictly-cast-bools.patch")
|
||||
(search-patch "abiword-use-proper-png-api.patch")
|
||||
(search-patch "abiword-pass-no-undefined-to-linker.patch")
|
||||
(search-patch "abiword-link-plugins-against-backend.patch")))))
|
||||
|
||||
(build-system gnu-build-system)
|
||||
(arguments ;; NOTE: rsvg is disabled, since Abiword
|
||||
`(#:configure-flags ;; supports it directly, and its BS is broken.
|
||||
(list
|
||||
"--enable-clipart" ;; TODO: The following plugins have unresolved
|
||||
"--enable-templates" ;; dependencies: aiksaurus, grammar, wpg, gda,
|
||||
(string-append ;; wordperfect, psion, mathview, goffice.
|
||||
"--enable-plugins="
|
||||
"applix " "babelfish " "bmp " "clarisworks " "collab " "command "
|
||||
"docbook " "eml " "freetranslation " "garble " "gdict " "gimp "
|
||||
"google " "hancom " "hrtext " "iscii " "kword " "latex "
|
||||
"loadbindings " "mht " "mif " "mswrite " "opendocument "
|
||||
"openwriter " "openxml " "opml " "ots " "paint " "passepartout "
|
||||
"pdb " "pdf " "presentation " "s5 " "sdw " "t602 " "urldict "
|
||||
"wikipedia " "wmf " "wml " "xslfo"))))
|
||||
(inputs
|
||||
`(("boost" ,boost)
|
||||
("enchant" ,enchant)
|
||||
("fontconfig" ,fontconfig)
|
||||
("fribidi" ,fribidi)
|
||||
("glib" ,glib)
|
||||
("gtk+" ,gtk+-2)
|
||||
("libglade" ,libglade)
|
||||
("libgsf" ,libgsf)
|
||||
("libjpeg" ,libjpeg)
|
||||
("libpng" ,libpng)
|
||||
("librsvg" ,librsvg)
|
||||
("libwmf" ,libwmf)
|
||||
("libxml2" ,libxml2)
|
||||
("ots" ,ots)
|
||||
("popt" ,popt)
|
||||
("readline" ,readline)
|
||||
("wv" ,wv)
|
||||
("zlib" ,zlib)))
|
||||
(native-inputs
|
||||
`(("intltool" ,intltool)
|
||||
("glib:bin" ,glib "bin")
|
||||
("pkg-config" ,pkg-config)))
|
||||
(home-page "http://abisource.org/")
|
||||
(synopsis "Word processing program")
|
||||
(description
|
||||
"AbiWord is a word processing program. It is rapidly becoming a state
|
||||
of the art word processor, with lots of features useful for your daily work,
|
||||
personal needs, or for just some good old typing fun.")
|
||||
(license license:gpl2+)))
|
||||
@@ -25,7 +25,7 @@
|
||||
(define-public acct
|
||||
(package
|
||||
(name "acct")
|
||||
(version "6.6.1")
|
||||
(version "6.6.2")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
@@ -33,7 +33,7 @@
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1jzz601cavml7894fjalw661gz28ia35002inw990agr3rhiaiam"))))
|
||||
"0081hzkcxw9aslpsakridj15m0wbnkdhm210fzbg021vi4pppm4f"))))
|
||||
(build-system gnu-build-system)
|
||||
(home-page "https://gnu.org/software/acct/")
|
||||
(synopsis "Standard login and process accounting utilities")
|
||||
|
||||
+11
-19
@@ -1,5 +1,6 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org>
|
||||
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -28,7 +29,7 @@
|
||||
(define-public acl
|
||||
(package
|
||||
(name "acl")
|
||||
(version "2.2.51")
|
||||
(version "2.2.52")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
@@ -36,30 +37,21 @@
|
||||
version ".src.tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"09aj30m49ivycl3irram8c3givc0crivjm3ymw0nhfaxrwhlb186"))))
|
||||
"08qd9s3wfhv0ajswsylnfwr5h0d7j9d4rgip855nrh400nxp940p"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
`(#:phases
|
||||
`(#:tests? #f ; FIXME: Investigate test suite failures
|
||||
#:phases
|
||||
(alist-cons-after
|
||||
'configure 'patch-makefile-SHELL
|
||||
(lambda _
|
||||
(patch-makefile-SHELL "include/buildmacros"))
|
||||
,(if (%current-target-system)
|
||||
'%standard-phases
|
||||
'(alist-replace 'check
|
||||
(lambda _
|
||||
(system* "make" "tests" "-C" "test")
|
||||
|
||||
;; XXX: Ignore the test result since this is
|
||||
;; dependent on the underlying file system.
|
||||
#t)
|
||||
%standard-phases)))))
|
||||
(inputs `(("attr" ,attr)
|
||||
|
||||
;; Perl is needed to run tests; remove it from cross builds.
|
||||
,@(if (%current-target-system)
|
||||
'()
|
||||
`(("perl" ,perl)))))
|
||||
(alist-replace
|
||||
'install
|
||||
(lambda _
|
||||
(zero? (system* "make" "install" "install-lib")))
|
||||
%standard-phases))))
|
||||
(inputs `(("attr" ,attr)))
|
||||
(native-inputs
|
||||
`(("gettext" ,gnu-gettext)))
|
||||
|
||||
|
||||
+199
-14
@@ -36,18 +36,19 @@
|
||||
#:use-module (gnu packages gettext)
|
||||
#:use-module (gnu packages perl)
|
||||
#:use-module (gnu packages tcl)
|
||||
#:use-module ((gnu packages base)
|
||||
#:select (tar))
|
||||
#:use-module ((gnu packages compression)
|
||||
#:select (gzip))
|
||||
#:use-module ((gnu packages openssl)
|
||||
#:renamer (symbol-prefix-proc 'o:))
|
||||
#:use-module ((gnu packages compression) #:prefix c:)
|
||||
#:use-module ((gnu packages openssl) #:prefix o:)
|
||||
#:use-module (gnu packages bison)
|
||||
#:use-module (gnu packages flex)
|
||||
#:use-module (gnu packages glib)
|
||||
#:use-module (gnu packages pkg-config)
|
||||
#:use-module (gnu packages popt)
|
||||
#:use-module (gnu packages texinfo)
|
||||
#:use-module (gnu packages groff)
|
||||
#:use-module (gnu packages pciutils)
|
||||
#:use-module (gnu packages libusb)
|
||||
#:use-module (gnu packages libftdi)
|
||||
#:use-module (gnu packages image)
|
||||
#:use-module (gnu packages xorg))
|
||||
|
||||
(define-public dmd
|
||||
@@ -273,15 +274,15 @@ allow automatic login and starting any app.")
|
||||
(define-public net-base
|
||||
(package
|
||||
(name "net-base")
|
||||
(version "5.2")
|
||||
(version "5.3")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
"mirror://debian/pool/main/n/netbase/netbase_"
|
||||
version ".tar.gz"))
|
||||
version ".tar.xz"))
|
||||
(sha256
|
||||
(base32
|
||||
"01rkvqrg7krkx8b432nz6bpi8w3s4cm5q5r891k23cdrc9nsaayn"))))
|
||||
"12xqjwg3p4rzmmh2iib6sigm9l29y3dgk74mmnw64k84jnbwdxl1"))))
|
||||
(build-system trivial-build-system)
|
||||
(arguments
|
||||
`(#:modules ((guix build utils))
|
||||
@@ -291,10 +292,10 @@ allow automatic login and starting any app.")
|
||||
|
||||
(let* ((source (assoc-ref %build-inputs "source"))
|
||||
(tar (assoc-ref %build-inputs "tar"))
|
||||
(gzip (assoc-ref %build-inputs "gzip"))
|
||||
(xz (assoc-ref %build-inputs "xz"))
|
||||
(output (assoc-ref %outputs "out"))
|
||||
(etc (string-append output "/etc")))
|
||||
(setenv "PATH" (string-append gzip "/bin"))
|
||||
(setenv "PATH" (string-append xz "/bin"))
|
||||
(system* (string-append tar "/bin/tar") "xvf"
|
||||
source)
|
||||
(chdir ,(string-append "netbase-" version))
|
||||
@@ -305,7 +306,7 @@ allow automatic login and starting any app.")
|
||||
'("services" "protocols" "rpc")))
|
||||
#t))))
|
||||
(native-inputs `(("tar" ,tar)
|
||||
("gzip" ,gzip)))
|
||||
("xz" ,c:xz)))
|
||||
(synopsis "IANA protocol, port, and RPC number assignments")
|
||||
(description
|
||||
"This package provides the /etc/services, /etc/protocols, and /etc/rpc
|
||||
@@ -339,7 +340,7 @@ ONC RPC numbers")
|
||||
"Netcat is a featured networking utility which reads and writes data
|
||||
across network connections, using the TCP/IP protocol. It is designed to be a
|
||||
reliable \"back-end\" tool that can be used directly or easily driven by other
|
||||
programs and scripts. At the same time, it is a feature-rich network debugging
|
||||
programs and scripts. At the same time, it is a feature-rich network debugging
|
||||
and exploration tool, since it can create almost any kind of connection you
|
||||
would need and has several interesting built-in capabilities.")
|
||||
(license gpl2+)))
|
||||
@@ -630,7 +631,7 @@ system administrator.")
|
||||
"002l6h27pnhb77b65frhazbhknsxvrsnkpi43j7i0qw1lrgi7nkf"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
'(#:configure-flags '("--with-logpath=/var/log/sudo.log")
|
||||
`(#:configure-flags '("--with-logpath=/var/log/sudo.log")
|
||||
#:phases (alist-cons-before
|
||||
'configure 'pre-configure
|
||||
(lambda _
|
||||
@@ -762,3 +763,187 @@ This package provides the 'wpa_supplicant' daemon and the 'wpa_cli' command.")
|
||||
"WakeLan broadcasts a properly formatted UDP packet across the local area
|
||||
network, which causes enabled computers to power on.")
|
||||
(license gpl2+)))
|
||||
|
||||
(define-public dmidecode
|
||||
(package
|
||||
(name "dmidecode")
|
||||
(version "2.12")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
"mirror://savannah/dmidecode/dmidecode-"
|
||||
version ".tar.bz2"))
|
||||
(sha256
|
||||
(base32
|
||||
"122hgaw8mpqdfra159lfl6pyk3837giqx6vq42j64fjnbl2z6gwi"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
'(#:phases (alist-delete 'configure %standard-phases)
|
||||
#:tests? #f ; no 'check' target
|
||||
#:make-flags (list (string-append "prefix="
|
||||
(assoc-ref %outputs "out")))))
|
||||
(home-page "http://www.nongnu.org/dmidecode/")
|
||||
(synopsis "Read hardware information from the BIOS")
|
||||
(description
|
||||
"Dmidecode reports information about your system's hardware as described
|
||||
in your system BIOS according to the SMBIOS/DMI standard. This typically
|
||||
includes system manufacturer, model name, serial number, BIOS version, asset
|
||||
tag as well as a lot of other details of varying level of interest and
|
||||
reliability depending on the manufacturer. This will often include usage
|
||||
status for the CPU sockets, expansion slots (e.g. AGP, PCI, ISA) and memory
|
||||
module slots, and the list of I/O ports (e.g. serial, parallel, USB).")
|
||||
(license gpl2+)))
|
||||
|
||||
(define-public acpica
|
||||
(package
|
||||
(name "acpica")
|
||||
(version "20140724")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
"https://acpica.org/sites/acpica/files/acpica-unix2-"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"01vdgrh7dsxrrvg5yd8sxm63cw8210pnsi5qg9g15ac53gn243ac"))))
|
||||
(build-system gnu-build-system)
|
||||
(native-inputs `(("flex" ,flex)
|
||||
("bison" ,bison)))
|
||||
(arguments
|
||||
'(#:make-flags (list (string-append "PREFIX=" %output)
|
||||
"HOST=_LINUX"
|
||||
"OPT_CFLAGS=-Wall -fno-strict-aliasing")
|
||||
#:tests? #f ; no 'check' target.
|
||||
#:phases (alist-delete 'configure %standard-phases)))
|
||||
(home-page "http://acpica.org/")
|
||||
(synopsis "Tools for the development and debug of ACPI tables")
|
||||
(description
|
||||
"The ACPI Component Architecture (ACPICA) project provides an
|
||||
OS-independent reference implementation of the Advanced Configuration and
|
||||
Power Interface Specification (ACPI). ACPICA code contains those portions of
|
||||
ACPI meant to be directly integrated into the host OS as a kernel-resident
|
||||
subsystem, and a small set of tools to assist in developing and debugging ACPI
|
||||
tables. This package contains only the user-space tools needed for ACPI table
|
||||
development, not the kernel implementation of ACPI.")
|
||||
(license gpl2))) ; Dual GPLv2/ACPICA Licence
|
||||
|
||||
(define-public stress
|
||||
(package
|
||||
(name "stress")
|
||||
(version "1.0.1")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://debian/pool/main/s/stress/stress_"
|
||||
version ".orig.tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1v9vnzlihqfjsxa93hdbrq72pqqk00dkylmlg8jpxhm7s1w9qfl1"))))
|
||||
(build-system gnu-build-system)
|
||||
(home-page "http://packages.debian.org/wheezy/stress")
|
||||
(synopsis "Impose load on and stress test a computer system")
|
||||
(description
|
||||
"Stress is a tool that imposes a configurable amount of CPU, memory, I/O,
|
||||
or disk stress on a POSIX-compliant operating system and reports any errors it
|
||||
detects.
|
||||
|
||||
Stress is not a benchmark. It is a tool used by system administrators to
|
||||
evaluate how well their systems will scale, by kernel programmers to evaluate
|
||||
perceived performance characteristics, and by systems programmers to expose
|
||||
the classes of bugs which only or more frequently manifest themselves when the
|
||||
system is under heavy load.")
|
||||
(license gpl2+)))
|
||||
|
||||
(define-public detox
|
||||
(package
|
||||
(name "detox")
|
||||
(version "1.2.0")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://sourceforge/detox/detox-"
|
||||
version ".tar.bz2"))
|
||||
(sha256
|
||||
(base32
|
||||
"1y6vvjqsg54kl49cry73jbfhr04s7wjs779vrr9zrq6kww7dkymb"))))
|
||||
(build-system gnu-build-system)
|
||||
;; Both flex and popt are used in this case for their runtime libraries
|
||||
;; (libfl and libpopt).
|
||||
(inputs
|
||||
`(("flex" ,flex)
|
||||
("popt" ,popt)))
|
||||
(arguments
|
||||
`(#:configure-flags `(,(string-append "--with-popt="
|
||||
(assoc-ref %build-inputs "popt")))
|
||||
#:tests? #f)) ;no 'check' target
|
||||
(home-page "http://detox.sourceforge.net")
|
||||
(synopsis "Clean up filenames")
|
||||
(description
|
||||
"Detox is a program that renames files to make them easier to work with
|
||||
under Unix and related operating systems. Spaces and various other unsafe
|
||||
characters (such as \"$\") get replaced with \"_\". ISO 8859-1 (Latin-1)
|
||||
characters can be replaced as well, as can UTF-8 characters.")
|
||||
(license bsd-3)))
|
||||
|
||||
(define-public testdisk
|
||||
(package
|
||||
(name "testdisk")
|
||||
(version "6.14")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "http://www.cgsecurity.org/testdisk-"
|
||||
version ".tar.bz2"))
|
||||
(sha256
|
||||
(base32
|
||||
"0v1jap83f5h99zv01v3qmqm160d36n4ysi0gyq7xzb3mqgmw75x5"))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs
|
||||
`(;; ("ntfs" ,ntfs)
|
||||
("util-linux" ,util-linux)
|
||||
("openssl" ,o:openssl)
|
||||
("zlib" ,c:zlib)
|
||||
("e2fsprogs" ,e2fsprogs)
|
||||
("libjpeg" ,libjpeg)
|
||||
("ncurses" ,ncurses)))
|
||||
(home-page "http://www.cgsecurity.org/wiki/TestDisk")
|
||||
(synopsis "Data recovery tool")
|
||||
(description
|
||||
"TestDisk is a program for data recovery, primarily designed to help
|
||||
recover lost partitions and/or make non-booting disks bootable again.")
|
||||
(license gpl2+)))
|
||||
|
||||
(define-public direvent
|
||||
(package
|
||||
(name "direvent")
|
||||
(version "5.0")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnu/direvent/direvent-"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1i14131y6m8wvirz6piw4zxz2q1kbpl0lniv5kl55rx4k372dg8z"))
|
||||
(modules '((guix build utils)))
|
||||
(snippet '(substitute* "tests/testsuite"
|
||||
(("#![[:blank:]]?/bin/sh")
|
||||
"#!$SHELL")))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
'(#:phases (alist-cons-before
|
||||
'build 'patch-/bin/sh
|
||||
(lambda* (#:key inputs #:allow-other-keys)
|
||||
;; Use the right shell when executing the watcher.
|
||||
(let ((bash (assoc-ref inputs "bash")))
|
||||
(substitute* "src/direvent.c"
|
||||
(("\"/bin/sh\"")
|
||||
(string-append "\"" bash "/bin/sh\"")))))
|
||||
%standard-phases)))
|
||||
(home-page "http://www.gnu.org/software/direvent/")
|
||||
(synopsis "Daemon to monitor directories for events such as file removal")
|
||||
(description
|
||||
"A daemon that monitors directories for events, such as creating,
|
||||
deleting or modifying files. It can monitor different sets of directories for
|
||||
different events. When an event is detected, direvent calls a specified
|
||||
external program with information about the event, such as the location
|
||||
within the file system where it occurred. Thus, \"direvent\" provides an
|
||||
easy way to react immediately if given files undergo changes, for example, to
|
||||
track changes in important system configuration files.")
|
||||
(license gpl3+)))
|
||||
|
||||
@@ -0,0 +1,55 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2014 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/>.
|
||||
|
||||
(define-module (gnu packages adns)
|
||||
#:use-module (guix licenses)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix build-system gnu))
|
||||
|
||||
(define-public adns
|
||||
(package
|
||||
(name "adns")
|
||||
(version "1.5.0")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (list (string-append "mirror://gnu/adns/adns-"
|
||||
version ".tar.gz")
|
||||
(string-append
|
||||
"http://www.chiark.greenend.org.uk/~ian/adns/ftp/adns-"
|
||||
version ".tar.gz")))
|
||||
(sha256
|
||||
(base32
|
||||
"0hg89b5n84zjhzvbzrpvhl0hbm4s6d1z2pzllfis64ai656ypibz"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
;; Make sure the programs under bin/ fine libadns.so.
|
||||
'(#:configure-flags (list (string-append "LDFLAGS=-Wl,-rpath -Wl,"
|
||||
(assoc-ref %outputs "out")
|
||||
"/lib"))
|
||||
|
||||
;; XXX: Tests expect real name resolution to work.
|
||||
#:tests? #f))
|
||||
(home-page "http://www.gnu.org/software/adns/")
|
||||
(synopsis "Asynchronous DNS client library and utilities")
|
||||
(description
|
||||
"GNU adns is a C library that provides easy-to-use DNS resolution
|
||||
functionality. The library is asynchronous, allowing several concurrent
|
||||
calls. The package also includes several command-line utilities for use in
|
||||
scripts.")
|
||||
(license gpl3+)))
|
||||
@@ -18,8 +18,7 @@
|
||||
|
||||
(define-module (gnu packages aidc)
|
||||
#:use-module (gnu packages)
|
||||
#:use-module ((guix licenses)
|
||||
#:renamer (symbol-prefix-proc 'license:))
|
||||
#:use-module ((guix licenses) #:prefix license:)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix download)
|
||||
#:use-module (gnu packages pkg-config)
|
||||
@@ -63,7 +62,7 @@ formats.")
|
||||
(synopsis "Encode data into a QR Code symbol")
|
||||
(description "Libqrencode is a C library for encoding data in a QR Code
|
||||
symbol, a kind of 2D symbology that can be scanned by handy terminals such as
|
||||
a mobile phone with CCD. The capacity of QR Code is up to 7000 digits or 4000
|
||||
a mobile phone with CCD. The capacity of QR Code is up to 7000 digits or 4000
|
||||
characters, and is highly robust.")
|
||||
(license license:lgpl2.1+)
|
||||
(home-page "http://fukuchi.org/works/qrencode")))
|
||||
|
||||
+100
-7
@@ -48,14 +48,13 @@
|
||||
(inputs `(("gmp" ,gmp)
|
||||
("mpfr" ,mpfr)
|
||||
("mpc" ,mpc)))
|
||||
(synopsis "mpfrcx, a library for the arithmetic of univariate polynomials
|
||||
over arbitrary precision real or complex numbers")
|
||||
(synopsis "Arithmetic of polynomials over arbitrary precision numbers")
|
||||
(description
|
||||
"mpfrcx is a library for the arithmetic of univariate polynomials over
|
||||
"Mpfrcx is a library for the arithmetic of univariate polynomials over
|
||||
arbitrary precision real (mpfr) or complex (mpc) numbers, without control
|
||||
on the rounding. For the time being, only the few functions needed to
|
||||
on the rounding. For the time being, only the few functions needed to
|
||||
implement the floating point approach to complex multiplication are
|
||||
implemented. On the other hand, these comprise asymptotically fast
|
||||
implemented. On the other hand, these comprise asymptotically fast
|
||||
multiplication routines such as Toom–Cook and the FFT. ")
|
||||
(license lgpl2.1+)
|
||||
(home-page "http://mpfrcx.multiprecision.org/")))
|
||||
@@ -74,9 +73,9 @@ multiplication routines such as Toom–Cook and the FFT. ")
|
||||
(build-system gnu-build-system)
|
||||
(inputs `(("gmp" ,gmp)
|
||||
("mpfr" ,mpfr)))
|
||||
(synopsis "fplll, a library for LLL-reduction of euclidean lattices")
|
||||
(synopsis "Library for LLL-reduction of euclidean lattices")
|
||||
(description
|
||||
"fplll LLL-reduces euclidean lattices. Since version 3, it can also
|
||||
"fplll LLL-reduces euclidean lattices. Since version 3, it can also
|
||||
solve the shortest vector problem.")
|
||||
(license lgpl2.1+)
|
||||
(home-page "http://perso.ens-lyon.fr/damien.stehle/fplll/")))
|
||||
@@ -154,6 +153,100 @@ GP2C, the GP to C compiler, translates GP scripts to PARI programs.")
|
||||
(license gpl2)
|
||||
(home-page "http://pari.math.u-bordeaux.fr/")))
|
||||
|
||||
(define-public flint
|
||||
(package
|
||||
(name "flint")
|
||||
(version "2.4.4")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
"http://flintlib.org/flint-"
|
||||
version ".tar.gz"))
|
||||
(sha256 (base32
|
||||
"1isv1sfv8sg3qvf0d99apdfi3jnql95xfzszcawdf1pgjj9rwyf4"))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs
|
||||
`(("gmp" ,gmp)
|
||||
("mpfr" ,mpfr)))
|
||||
(arguments
|
||||
`(#:phases
|
||||
(alist-replace
|
||||
'configure
|
||||
(lambda* (#:key inputs outputs #:allow-other-keys)
|
||||
(let ((out (assoc-ref outputs "out"))
|
||||
(gmp (assoc-ref inputs "gmp"))
|
||||
(mpfr (assoc-ref inputs "mpfr")))
|
||||
;; Drop test failing with gmp-6 due to changed invertibility
|
||||
;; of 0 in Z/1 Z, which according to the flint authors has no
|
||||
;; impact on flint.
|
||||
;; FIXME: Drop with later version.
|
||||
(delete-file "fmpz/test/t-invmod.c")
|
||||
;; do not pass "--enable-fast-install", which makes the
|
||||
;; homebrew configure process fail
|
||||
(zero? (system*
|
||||
"./configure"
|
||||
(string-append "--prefix=" out)
|
||||
(string-append "--with-gmp=" gmp)
|
||||
(string-append "--with-mpfr=" mpfr)))))
|
||||
%standard-phases)))
|
||||
(synopsis "Fast library for number theory")
|
||||
(description
|
||||
"FLINT is a C library for number theory. It supports arithmetic
|
||||
with numbers, polynomials, power series and matrices over many base
|
||||
rings, including multiprecision integers and rationals, integers
|
||||
modulo n, p-adic numbers, finite fields (prime and non-prime order)
|
||||
and real and complex numbers (via the Arb extension library).
|
||||
|
||||
Operations that can be performed include conversions, arithmetic,
|
||||
GCDs, factoring, solving linear systems, and evaluating special
|
||||
functions. In addition, FLINT provides various low-level routines for
|
||||
fast arithmetic.")
|
||||
(license gpl2+)
|
||||
(home-page "http://flintlib.org/")))
|
||||
|
||||
(define-public arb
|
||||
(package
|
||||
(name "arb")
|
||||
(version "2.2.0")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
"https://github.com/fredrik-johansson/arb/archive/"
|
||||
version ".tar.gz"))
|
||||
(sha256 (base32
|
||||
"0a8cgzznkmr59ngj4di9a37b5h4i00gbnixnxlwd34bcbflvjzyr"))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs
|
||||
`(("flint" ,flint)
|
||||
("gmp" ,gmp)
|
||||
("mpfr" ,mpfr)))
|
||||
(arguments
|
||||
`(#:phases
|
||||
(alist-replace
|
||||
'configure
|
||||
(lambda* (#:key inputs outputs #:allow-other-keys)
|
||||
(let ((out (assoc-ref outputs "out"))
|
||||
(flint (assoc-ref inputs "flint"))
|
||||
(gmp (assoc-ref inputs "gmp"))
|
||||
(mpfr (assoc-ref inputs "mpfr")))
|
||||
;; do not pass "--enable-fast-install", which makes the
|
||||
;; homebrew configure process fail
|
||||
(zero? (system*
|
||||
"./configure"
|
||||
(string-append "--prefix=" out)
|
||||
(string-append "--with-flint=" flint)
|
||||
(string-append "--with-gmp=" gmp)
|
||||
(string-append "--with-mpfr=" mpfr)))))
|
||||
%standard-phases)))
|
||||
(synopsis "Arbitrary precision floating-point ball arithmetic")
|
||||
(description
|
||||
"Arb is a C library for arbitrary-precision floating-point ball
|
||||
arithmetic. It supports efficient high-precision computation with
|
||||
polynomials, power series, matrices and special functions over the
|
||||
real and complex numbers, with automatic, rigorous error control.")
|
||||
(license gpl2+)
|
||||
(home-page "http://fredrikj.net/arb/")))
|
||||
|
||||
(define-public bc
|
||||
(package
|
||||
(name "bc")
|
||||
|
||||
@@ -1,5 +1,6 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
|
||||
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -23,25 +24,31 @@
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (gnu packages gettext)
|
||||
#:use-module (gnu packages maths)
|
||||
#:use-module (gnu packages databases)
|
||||
#:use-module (gnu packages readline))
|
||||
|
||||
(define-public apl
|
||||
(package
|
||||
(name "apl")
|
||||
(version "1.3")
|
||||
(version "1.4")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnu/apl/apl-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1pkwlm0nf5vb8sp9hf9wjmsrsyr4vdpd4kv5y3hzmsgf3wcf8y3i"))))
|
||||
"0fl9l4jb5wpnb54kqkphavi657z1cv15h9qj2rqy2shf33dk3nk9"))))
|
||||
(build-system gnu-build-system)
|
||||
(home-page "http://www.gnu.org/software/apl/")
|
||||
(inputs
|
||||
`(("gettext" ,gnu-gettext)
|
||||
("lapack" ,lapack)
|
||||
("sqlite" ,sqlite)
|
||||
("readline" ,readline)))
|
||||
(arguments
|
||||
`(#:configure-flags (list (string-append
|
||||
"--with-sqlite3="
|
||||
(assoc-ref %build-inputs "sqlite")))))
|
||||
(synopsis "APL interpreter")
|
||||
(description
|
||||
"GNU APL is a free interpreter for the programming language APL. It is
|
||||
|
||||
@@ -1,5 +1,6 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
|
||||
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -28,14 +29,14 @@
|
||||
(define-public apr
|
||||
(package
|
||||
(name "apr")
|
||||
(version "1.4.8")
|
||||
(version "1.5.1")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://apache/apr/apr-"
|
||||
version ".tar.bz2"))
|
||||
(sha256
|
||||
(base32
|
||||
"0884csfk3f530yscak0jlr6w929s3ys0n7fpwdg3dii1sgwd5f31"))
|
||||
"1b4qw686bwjn19iyb0lg918q23xxd6s2gnyczhjq992d3m1vwjp9"))
|
||||
(patches
|
||||
(list (search-patch "apr-skip-getservbyname-test.patch")))
|
||||
(patch-flags '("-p0"))))
|
||||
@@ -44,7 +45,8 @@
|
||||
;; Sometimes we end up with two processes concurrently trying to make
|
||||
;; 'libmod_test.la': <http://hydra.gnu.org/build/60266/nixlog/2/raw>.
|
||||
;; Thus, build sequentially.
|
||||
'(#:parallel-build? #f))
|
||||
'(#:parallel-build? #f
|
||||
#:parallel-tests? #f))
|
||||
(inputs `(("perl" ,perl)
|
||||
("libtool" ,libtool)))
|
||||
(home-page "http://apr.apache.org/")
|
||||
@@ -52,7 +54,7 @@
|
||||
(description
|
||||
"The mission of the Apache Portable Runtime (APR) project is to create and
|
||||
maintain software libraries that provide a predictable and consistent interface
|
||||
to underlying platform-specific implementations. The primary goal is to provide
|
||||
to underlying platform-specific implementations. The primary goal is to provide
|
||||
an API to which software developers may code and be assured of predictable if
|
||||
not identical behaviour regardless of the platform on which their software is
|
||||
built, relieving them of the need to code special-case conditions to work
|
||||
@@ -62,14 +64,14 @@ around or take advantage of platform-specific deficiencies or features.")
|
||||
(define-public apr-util
|
||||
(package
|
||||
(name "apr-util")
|
||||
(version "1.5.2")
|
||||
(version "1.5.3")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://apache/apr/apr-util-"
|
||||
version ".tar.bz2"))
|
||||
(sha256
|
||||
(base32
|
||||
"19qjxpckb9p4j9pbk8kcirg6k5vqnjrqhnk9xx2c5m9964p3vkls"))))
|
||||
"0s1rpqjy5xr03k9s4xrsm5wvhj5286vlkf6jvqayw99yy5sb3vbq"))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs
|
||||
`(("apr" ,apr)))
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2013 Eric Bavier <bavier@member.fsf.org>
|
||||
;;; Copyright © 2013,2014 Eric Bavier <bavier@member.fsf.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -22,13 +22,14 @@
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (gnu packages)
|
||||
#:use-module (gnu packages perl)
|
||||
#:use-module (gnu packages which)
|
||||
#:use-module (gnu packages guile))
|
||||
|
||||
(define-public autogen
|
||||
(package
|
||||
(name "autogen")
|
||||
(version "5.18.2")
|
||||
(version "5.18.4")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
@@ -37,8 +38,9 @@
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0s2021bwpq6h199cbbranz96hhm5s7v66lc68h8v198vqbg049yc"))))
|
||||
"0pbjzwgvmjvi6nl1bcyhfc9kl93s6321dgmvp5dqdip7i8dgin9w"))))
|
||||
(build-system gnu-build-system)
|
||||
(native-inputs `(("perl" ,perl))) ;for doc generator mdoc
|
||||
(inputs `(("which" ,which)
|
||||
("guile" ,guile-2.0)))
|
||||
(arguments
|
||||
|
||||
+37
-1
@@ -1,5 +1,6 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -62,9 +63,44 @@
|
||||
`(("intltool" ,intltool)
|
||||
("glib" ,glib "bin")
|
||||
("pkg-config" ,pkg-config)))
|
||||
(synopsis "Avahi, an mDNS/DNS-SD implementation")
|
||||
(synopsis "Implementation of mDNS/DNS-SD protocols")
|
||||
(description
|
||||
"Avahi is a system which facilitates service discovery on a local
|
||||
network. It is an implementation of the mDNS (for \"Multicast DNS\") and
|
||||
DNS-SD (for \"DNS-Based Service Discovery\") protocols.")
|
||||
(license lgpl2.1+)))
|
||||
|
||||
(define-public nss-mdns
|
||||
(package
|
||||
(name "nss-mdns")
|
||||
(version "0.10")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (list
|
||||
(string-append
|
||||
"mirror://debian/pool/main/n/nss-mdns/nss-mdns_"
|
||||
version ".orig.tar.gz")
|
||||
"http://pkgs.fedoraproject.org/repo/pkgs/nss-mdns/nss-mdns-0.10.tar.gz/03938f17646efbb50aa70ba5f99f51d7/nss-mdns-0.10.tar.gz"
|
||||
|
||||
;; This used to be the canonical URL but it vanished.
|
||||
;; See <http://bugs.gnu.org/18704>.
|
||||
;; (string-append
|
||||
;; "http://0pointer.de/lennart/projects/nss-mdns/nss-mdns-"
|
||||
;; version ".tar.gz")
|
||||
))
|
||||
(sha256
|
||||
(base32
|
||||
"0vgs6j0qsl0mwzh5a0m0bykr7x6bx79vnbyn0r3q289rghp3qs0y"))
|
||||
(file-name (string-append name "-" version ".tar.gz"))))
|
||||
(build-system gnu-build-system)
|
||||
|
||||
;; XXX: Stale URL, missing replacement. See <http://bugs.gnu.org/18704>.
|
||||
(home-page "http://0pointer.de/lennart/projects/nss-mdns/")
|
||||
|
||||
(synopsis "The mDNS Name Service Switch (NSS) plug-in")
|
||||
(description
|
||||
"Nss-mdns is a plug-in for the Name Service Switch (NSS) functionality
|
||||
of the GNU C Library, providing host name resolution via Multicast DNS (mDNS).
|
||||
It allows for name resolution by programs in the ad-hoc mDNS domain
|
||||
'.local'.")
|
||||
(license lgpl2.1+)))
|
||||
|
||||
+28
-13
@@ -1,5 +1,6 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
|
||||
;;; Copyright © 2014 Ian Denhardt <ian@zenhack.net>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -18,9 +19,9 @@
|
||||
|
||||
(define-module (gnu packages backup)
|
||||
#:use-module (guix packages)
|
||||
#:use-module ((guix licenses)
|
||||
#:renamer (symbol-prefix-proc 'license:))
|
||||
#:use-module ((guix licenses) #:prefix license:)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix utils)
|
||||
#:use-module (guix build utils)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (guix build-system python)
|
||||
@@ -30,15 +31,16 @@
|
||||
#:use-module (gnu packages dejagnu)
|
||||
#:use-module (gnu packages glib)
|
||||
#:use-module (gnu packages gnupg)
|
||||
#:use-module (gnu packages linux)
|
||||
#:use-module (gnu packages mcrypt)
|
||||
#:use-module (gnu packages nettle)
|
||||
#:use-module (gnu packages pcre)
|
||||
#:use-module (gnu packages python)
|
||||
#:use-module (gnu packages linux)
|
||||
#:use-module (gnu packages pkg-config)
|
||||
#:use-module (gnu packages rsync)
|
||||
#:use-module (gnu packages ssh)
|
||||
#:use-module (gnu packages xml)
|
||||
#:use-module (srfi srfi-1))
|
||||
#:use-module (gnu packages xml))
|
||||
|
||||
(define-public duplicity
|
||||
(package
|
||||
@@ -48,29 +50,38 @@
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "https://code.launchpad.net/duplicity/"
|
||||
(string-join (take (string-split version #\.) 2) ".")
|
||||
(version-major+minor version)
|
||||
"-series/" version "/+download/duplicity-"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0l14nrhbgkyjgvh339bbhnm6hrdwrjadphq1jmpi0mcgcdbdfh8x"))))
|
||||
"0l14nrhbgkyjgvh339bbhnm6hrdwrjadphq1jmpi0mcgcdbdfh8x"))
|
||||
(patches (list (search-patch "duplicity-piped-password.patch")
|
||||
(search-patch "duplicity-test_selection-tmp.patch")))))
|
||||
(build-system python-build-system)
|
||||
(native-inputs
|
||||
`(("python2-setuptools" ,python2-setuptools)))
|
||||
`(("python2-setuptools" ,python2-setuptools)
|
||||
("util-linux" ,util-linux))) ;setsid command, for the tests
|
||||
(inputs
|
||||
`(("python" ,python-2)
|
||||
("librsync" ,librsync)
|
||||
("mock" ,python2-mock) ;for testing
|
||||
("lockfile" ,python2-lockfile)
|
||||
("gnupg" ,gnupg-1))) ;gpg executable needed
|
||||
("gnupg" ,gnupg-1) ;gpg executable needed
|
||||
("util-linux" ,util-linux) ;for setsid
|
||||
("tzdata" ,tzdata)))
|
||||
(arguments
|
||||
`(#:python ,python-2 ;setup assumes Python 2
|
||||
#:test-target "test"
|
||||
#:phases (alist-cons-before
|
||||
'check 'patch-tests
|
||||
(lambda _
|
||||
'check 'check-setup
|
||||
(lambda* (#:key inputs #:allow-other-keys)
|
||||
(substitute* "testing/functional/__init__.py"
|
||||
(("/bin/sh") (which "sh"))))
|
||||
(("/bin/sh") (which "sh")))
|
||||
(setenv "HOME" (getcwd)) ;gpg needs to write to $HOME
|
||||
(setenv "TZDIR" ;some timestamp checks need TZDIR
|
||||
(string-append (assoc-ref inputs "tzdata")
|
||||
"/share/zoneinfo")))
|
||||
%standard-phases)))
|
||||
(home-page "http://duplicity.nongnu.org/index.html")
|
||||
(synopsis "Encrypted backup using rsync algorithm")
|
||||
@@ -128,7 +139,11 @@ backups (called chunks) to allow easy burning to CD/DVD.")
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0pixqnrcf35dnqgv0lp7qlcw7k13620qkhgxr288v7p4iz6ym1zb"))))
|
||||
"0pixqnrcf35dnqgv0lp7qlcw7k13620qkhgxr288v7p4iz6ym1zb"))
|
||||
(patches
|
||||
(list (search-patch "libarchive-mtree-filename-length-fix.patch")
|
||||
(search-patch "libarchive-fix-lzo-test-case.patch")
|
||||
(search-patch "libarchive-CVE-2013-0211.patch")))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs
|
||||
`(("zlib" ,zlib)
|
||||
@@ -167,7 +182,7 @@ archives in various formats such as tar and cpio. Libarchive also supports
|
||||
reading and writing archives compressed using various compression filters such
|
||||
as gzip and bzip2. The library is inherently stream-oriented; readers
|
||||
serially iterate through the archive, writers serially add things to the
|
||||
archive. In particular, note that there is currently no built-in support for
|
||||
archive. In particular, note that there is currently no built-in support for
|
||||
random access nor for in-place modification.")
|
||||
(license license:bsd-2)))
|
||||
|
||||
|
||||
+33
-744
@@ -25,10 +25,7 @@
|
||||
#:use-module (gnu packages)
|
||||
#:use-module (gnu packages acl)
|
||||
#:use-module (gnu packages bash)
|
||||
#:use-module (gnu packages bootstrap)
|
||||
#:use-module (gnu packages compression)
|
||||
#:use-module (gnu packages gcc)
|
||||
#:use-module (gnu packages gawk)
|
||||
#:use-module (gnu packages ed)
|
||||
#:use-module (gnu packages guile)
|
||||
#:use-module (gnu packages multiprecision)
|
||||
#:use-module (gnu packages perl)
|
||||
@@ -37,13 +34,7 @@
|
||||
#:use-module (gnu packages pkg-config)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (guix build-system trivial)
|
||||
#:use-module (guix utils)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (ice-9 vlist)
|
||||
#:use-module (ice-9 match))
|
||||
#:use-module (guix build-system gnu))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
@@ -54,13 +45,13 @@
|
||||
(define-public hello
|
||||
(package
|
||||
(name "hello")
|
||||
(version "2.9")
|
||||
(version "2.10")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnu/hello/hello-" version
|
||||
".tar.gz"))
|
||||
(sha256
|
||||
(base32 "19qy37gkasc4csb1d3bdiz9snn8mir2p3aj0jgzmfv0r2hi7mfzc"))))
|
||||
(base32 "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i"))))
|
||||
(build-system gnu-build-system)
|
||||
(synopsis "Hello, GNU world: An example GNU package")
|
||||
(description
|
||||
@@ -84,7 +75,7 @@ command-line arguments, multiple languages, and so on.")
|
||||
(build-system gnu-build-system)
|
||||
(synopsis "Print lines matching a pattern")
|
||||
(description
|
||||
"grep is a tool for finding text inside files. Text is found by
|
||||
"grep is a tool for finding text inside files. Text is found by
|
||||
matching a pattern provided by the user in one or many files. The pattern
|
||||
may be provided as a basic or extended regular expression, or as fixed
|
||||
strings. By default, the matching text is simply printed to the screen,
|
||||
@@ -132,14 +123,14 @@ implementation offers several extensions over the standard utility.")
|
||||
(define-public tar
|
||||
(package
|
||||
(name "tar")
|
||||
(version "1.27.1")
|
||||
(version "1.28")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnu/tar/tar-"
|
||||
version ".tar.bz2"))
|
||||
version ".tar.xz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1iip0fk0wqhxb0jcwphz43r4fxkx1y7mznnhmlvr618jhp7b63wv"))))
|
||||
"1wi2zwm4c9r3h3b8y4w0nm0qq897kn8kyj9k22ba0iqvxj48vvk4"))))
|
||||
(build-system gnu-build-system)
|
||||
(synopsis "Managing tar archives")
|
||||
(description
|
||||
@@ -164,12 +155,9 @@ standard utility.")
|
||||
(base32
|
||||
"1sqckf560pzwgniy00vcpdv2c9c11s4cmhlm14yqgg8avd3bl94i"))))
|
||||
(build-system gnu-build-system)
|
||||
(native-inputs '()) ; FIXME: needs `ed' for the tests
|
||||
(arguments
|
||||
'(#:tests? #f)
|
||||
(native-inputs `(("ed", ed)))
|
||||
;; TODO: When cross-compiling, add this:
|
||||
;; '(#:configure-flags '("ac_cv_func_strnlen_working=yes"))
|
||||
)
|
||||
(synopsis "Apply differences to originals, with optional backups")
|
||||
(description
|
||||
"Patch is a program that applies changes to files based on differences
|
||||
@@ -235,17 +223,15 @@ used to apply commands with arbitrarily long arguments.")
|
||||
(define-public coreutils
|
||||
(package
|
||||
(name "coreutils")
|
||||
(version "8.22")
|
||||
(version "8.23")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnu/coreutils/coreutils-"
|
||||
version ".tar.xz"))
|
||||
(sha256
|
||||
(base32
|
||||
"04hjzzv434fb8ak3hh3dyhdvg3hqjjwvjmjxqzk1gh2jh6cr8gjv"))
|
||||
(patches (list (search-patch "coreutils-dummy-man.patch")
|
||||
;; TODO: remove this patch for >= 8.23
|
||||
(search-patch "coreutils-skip-nohup.patch")))))
|
||||
"0bdq6yggyl7nkc2pbl6pxhhyx15nyqhz3ds6rfn448n6rxdwlhzc"))
|
||||
(patches (list (search-patch "coreutils-dummy-man.patch")))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs `(("acl" ,acl) ; TODO: add SELinux
|
||||
("gmp" ,gmp)))
|
||||
@@ -287,14 +273,14 @@ functionality beyond that which is outlined in the POSIX standard.")
|
||||
(define-public gnu-make
|
||||
(package
|
||||
(name "make")
|
||||
(version "4.0")
|
||||
(version "4.1")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnu/make/make-" version
|
||||
".tar.bz2"))
|
||||
(sha256
|
||||
(base32
|
||||
"1nyvn8mknw0mf7727lprva3lisl1y0n03lvar342rrpdmz3qc1p6"))
|
||||
"19gwwhik3wdwn0r42b7xcihkbxvjl9r2bdal8nifc3k5i4rn3iqb"))
|
||||
(patches (list (search-patch "make-impure-dirs.patch")))))
|
||||
(build-system gnu-build-system)
|
||||
(native-inputs `(("pkg-config", pkg-config))) ; to detect Guile
|
||||
@@ -307,8 +293,8 @@ functionality beyond that which is outlined in the POSIX standard.")
|
||||
;; Change the default shell from /bin/sh.
|
||||
(let ((bash (assoc-ref inputs "bash")))
|
||||
(substitute* "job.c"
|
||||
(("default_shell\\[\\] =.*$")
|
||||
(format #f "default_shell[] = \"~a/bin/bash\";\n"
|
||||
(("default_shell =.*$")
|
||||
(format #f "default_shell = \"~a/bin/bash\";\n"
|
||||
bash)))))
|
||||
%standard-phases)))
|
||||
(synopsis "Remake files automatically")
|
||||
@@ -361,24 +347,25 @@ change. GNU make offers many powerful extensions over the standard utility.")
|
||||
(synopsis "Binary utilities: bfd gas gprof ld")
|
||||
(description
|
||||
"GNU Binutils is a collection of tools for working with binary files.
|
||||
Perhaps the most notable are \"ld\", a linker, and \"as\", an assembler. Other
|
||||
tools include programs to display binary profiling information, list the
|
||||
strings in a binary file, and utilities for working with archives. The \"bfd\"
|
||||
library for working with executable and object formats is also included.")
|
||||
Perhaps the most notable are \"ld\", a linker, and \"as\", an assembler.
|
||||
Other tools include programs to display binary profiling information, list
|
||||
the strings in a binary file, and utilities for working with archives. The
|
||||
\"bfd\" library for working with executable and object formats is also
|
||||
included.")
|
||||
(license gpl3+)
|
||||
(home-page "http://www.gnu.org/software/binutils/")))
|
||||
|
||||
(define-public glibc
|
||||
(package
|
||||
(name "glibc")
|
||||
(version "2.19")
|
||||
(version "2.20")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnu/glibc/glibc-"
|
||||
version ".tar.xz"))
|
||||
(sha256
|
||||
(base32
|
||||
"18m2dssd6ja5arxmdxinc90xvpqcsnqjfwmjl2as07j0i3srff9d"))
|
||||
"19bbyfc2gcxr9rihrkkbd3p362i608yhlyrr7icqsa6cmr16sjzq"))
|
||||
(snippet
|
||||
;; Disable 'ldconfig' and /etc/ld.so.cache. The latter is
|
||||
;; required on LFS distros to avoid loading the distro's libc.so
|
||||
@@ -418,10 +405,10 @@ library for working with executable and object formats is also included.")
|
||||
(assoc-ref %build-inputs "linux-headers")
|
||||
"/include")
|
||||
|
||||
;; The default is to assume a 2.4 Linux interface, but we'll
|
||||
;; always use something newer. See "kernel-features.h" in the
|
||||
;; GNU libc for details.
|
||||
"--enable-kernel=2.6.30"
|
||||
;; This is the default for most architectures as of GNU libc 2.20,
|
||||
;; but we specify it explicitly for clarity and consistency. See
|
||||
;; "kernel-features.h" in the GNU libc for details.
|
||||
"--enable-kernel=2.6.32"
|
||||
|
||||
;; Use our Bash instead of /bin/sh.
|
||||
(string-append "BASH_SHELL="
|
||||
@@ -575,713 +562,15 @@ with the Linux kernel.")
|
||||
(synopsis "Database of current and historical time zones")
|
||||
(description "The Time Zone Database (often called tz or zoneinfo)
|
||||
contains code and data that represent the history of local time for many
|
||||
representative locations around the globe. It is updated periodically to
|
||||
representative locations around the globe. It is updated periodically to
|
||||
reflect changes made by political bodies to time zone boundaries, UTC offsets,
|
||||
and daylight-saving rules.")
|
||||
(license public-domain)))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Bootstrap packages.
|
||||
;;;
|
||||
|
||||
(define gnu-make-boot0
|
||||
(package-with-bootstrap-guile
|
||||
(package (inherit gnu-make)
|
||||
(name "make-boot0")
|
||||
(location (source-properties->location (current-source-location)))
|
||||
(arguments
|
||||
`(#:guile ,%bootstrap-guile
|
||||
#:implicit-inputs? #f
|
||||
#:tests? #f ; cannot run "make check"
|
||||
,@(substitute-keyword-arguments (package-arguments gnu-make)
|
||||
((#:phases phases)
|
||||
`(alist-replace
|
||||
'build (lambda _
|
||||
;; Don't attempt to build 'guile.c' since we don't
|
||||
;; have Guile here.
|
||||
(substitute* "build.sh"
|
||||
(("guile\\.\\$\\{OBJEXT\\}") ""))
|
||||
(zero? (system* "./build.sh")))
|
||||
(alist-replace
|
||||
'install (lambda* (#:key outputs #:allow-other-keys)
|
||||
(let* ((out (assoc-ref outputs "out"))
|
||||
(bin (string-append out "/bin")))
|
||||
(mkdir-p bin)
|
||||
(copy-file "make"
|
||||
(string-append bin "/make"))))
|
||||
,phases))))))
|
||||
(native-inputs '()) ; no need for 'pkg-config'
|
||||
(inputs %bootstrap-inputs))))
|
||||
|
||||
(define diffutils-boot0
|
||||
(package-with-bootstrap-guile
|
||||
(let ((p (package-with-explicit-inputs diffutils
|
||||
`(("make" ,gnu-make-boot0)
|
||||
,@%bootstrap-inputs)
|
||||
#:guile %bootstrap-guile)))
|
||||
(package (inherit p)
|
||||
(location (source-properties->location (current-source-location)))
|
||||
(arguments `(#:tests? #f ; the test suite needs diffutils
|
||||
,@(package-arguments p)))))))
|
||||
|
||||
(define findutils-boot0
|
||||
(package-with-bootstrap-guile
|
||||
(package-with-explicit-inputs findutils
|
||||
`(("make" ,gnu-make-boot0)
|
||||
("diffutils" ,diffutils-boot0) ; for tests
|
||||
,@%bootstrap-inputs)
|
||||
(current-source-location)
|
||||
#:guile %bootstrap-guile)))
|
||||
|
||||
|
||||
(define %boot0-inputs
|
||||
`(("make" ,gnu-make-boot0)
|
||||
("diffutils" ,diffutils-boot0)
|
||||
("findutils" ,findutils-boot0)
|
||||
,@%bootstrap-inputs))
|
||||
|
||||
(define* (nix-system->gnu-triplet
|
||||
#:optional (system (%current-system)) (vendor "unknown"))
|
||||
"Return an a guess of the GNU triplet corresponding to Nix system
|
||||
identifier SYSTEM."
|
||||
(let* ((dash (string-index system #\-))
|
||||
(arch (substring system 0 dash))
|
||||
(os (substring system (+ 1 dash))))
|
||||
(string-append arch
|
||||
"-" vendor "-"
|
||||
(if (string=? os "linux")
|
||||
"linux-gnu"
|
||||
os))))
|
||||
|
||||
(define* (boot-triplet #:optional (system (%current-system)))
|
||||
;; Return the triplet used to create the cross toolchain needed in the
|
||||
;; first bootstrapping stage.
|
||||
(nix-system->gnu-triplet system "guix"))
|
||||
|
||||
;; Following Linux From Scratch, build a cross-toolchain in stage 0. That
|
||||
;; toolchain actually targets the same OS and arch, but it has the advantage
|
||||
;; of being independent of the libc and tools in %BOOTSTRAP-INPUTS, since
|
||||
;; GCC-BOOT0 (below) is built without any reference to the target libc.
|
||||
|
||||
(define binutils-boot0
|
||||
(package-with-bootstrap-guile
|
||||
(package (inherit binutils)
|
||||
(name "binutils-cross-boot0")
|
||||
(arguments
|
||||
`(#:guile ,%bootstrap-guile
|
||||
#:implicit-inputs? #f
|
||||
,@(substitute-keyword-arguments (package-arguments binutils)
|
||||
((#:configure-flags cf)
|
||||
`(cons ,(string-append "--target=" (boot-triplet))
|
||||
,cf)))))
|
||||
(inputs %boot0-inputs))))
|
||||
|
||||
(define gcc-boot0
|
||||
(package-with-bootstrap-guile
|
||||
(package (inherit gcc-4.8)
|
||||
(name "gcc-cross-boot0")
|
||||
(arguments
|
||||
`(#:guile ,%bootstrap-guile
|
||||
#:implicit-inputs? #f
|
||||
#:modules ((guix build gnu-build-system)
|
||||
(guix build utils)
|
||||
(ice-9 regex)
|
||||
(srfi srfi-1)
|
||||
(srfi srfi-26))
|
||||
,@(substitute-keyword-arguments (package-arguments gcc-4.8)
|
||||
((#:configure-flags flags)
|
||||
`(append (list ,(string-append "--target=" (boot-triplet))
|
||||
|
||||
;; No libc yet.
|
||||
"--without-headers"
|
||||
|
||||
;; Disable features not needed at this stage.
|
||||
"--disable-shared"
|
||||
"--enable-languages=c,c++"
|
||||
|
||||
;; libstdc++ cannot be built at this stage
|
||||
;; ("Link tests are not allowed after
|
||||
;; GCC_NO_EXECUTABLES.").
|
||||
"--disable-libstdc++-v3"
|
||||
|
||||
"--disable-threads"
|
||||
"--disable-libmudflap"
|
||||
"--disable-libatomic"
|
||||
"--disable-libsanitizer"
|
||||
"--disable-libitm"
|
||||
"--disable-libgomp"
|
||||
"--disable-libssp"
|
||||
"--disable-libquadmath"
|
||||
"--disable-decimal-float")
|
||||
(remove (cut string-match "--enable-languages.*" <>)
|
||||
,flags)))
|
||||
((#:phases phases)
|
||||
`(alist-cons-after
|
||||
'unpack 'unpack-gmp&co
|
||||
(lambda* (#:key inputs #:allow-other-keys)
|
||||
(let ((gmp (assoc-ref %build-inputs "gmp-source"))
|
||||
(mpfr (assoc-ref %build-inputs "mpfr-source"))
|
||||
(mpc (assoc-ref %build-inputs "mpc-source")))
|
||||
|
||||
;; To reduce the set of pre-built bootstrap inputs, build
|
||||
;; GMP & co. from GCC.
|
||||
(for-each (lambda (source)
|
||||
(or (zero? (system* "tar" "xvf" source))
|
||||
(error "failed to unpack tarball"
|
||||
source)))
|
||||
(list gmp mpfr mpc))
|
||||
|
||||
;; Create symlinks like `gmp' -> `gmp-x.y.z'.
|
||||
,@(map (lambda (lib)
|
||||
;; Drop trailing letters, as gmp-6.0.0a unpacks
|
||||
;; into gmp-6.0.0.
|
||||
`(symlink ,(string-trim-right
|
||||
(package-full-name lib)
|
||||
char-set:letter)
|
||||
,(package-name lib)))
|
||||
(list gmp mpfr mpc))))
|
||||
(alist-cons-after
|
||||
'install 'symlink-libgcc_eh
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(let ((out (assoc-ref outputs "lib")))
|
||||
;; Glibc wants to link against libgcc_eh, so provide
|
||||
;; it.
|
||||
(with-directory-excursion
|
||||
(string-append out "/lib/gcc/"
|
||||
,(boot-triplet)
|
||||
"/" ,(package-version gcc-4.8))
|
||||
(symlink "libgcc.a" "libgcc_eh.a"))))
|
||||
,phases))))))
|
||||
|
||||
(inputs `(("gmp-source" ,(package-source gmp))
|
||||
("mpfr-source" ,(package-source mpfr))
|
||||
("mpc-source" ,(package-source mpc))
|
||||
("binutils-cross" ,binutils-boot0)
|
||||
|
||||
;; Call it differently so that the builder can check whether
|
||||
;; the "libc" input is #f.
|
||||
("libc-native" ,@(assoc-ref %boot0-inputs "libc"))
|
||||
,@(alist-delete "libc" %boot0-inputs)))
|
||||
|
||||
;; No need for Texinfo at this stage.
|
||||
(native-inputs (alist-delete "texinfo"
|
||||
(package-native-inputs gcc-4.8))))))
|
||||
|
||||
(define perl-boot0
|
||||
(package-with-bootstrap-guile
|
||||
(package-with-explicit-inputs perl
|
||||
%boot0-inputs
|
||||
(current-source-location)
|
||||
#:guile %bootstrap-guile)))
|
||||
|
||||
(define (linux-libre-headers-boot0)
|
||||
"Return Linux-Libre header files for the bootstrap environment."
|
||||
;; Note: this is wrapped in a thunk to nicely handle circular dependencies
|
||||
;; between (gnu packages linux) and this module.
|
||||
(package-with-bootstrap-guile
|
||||
(package (inherit linux-libre-headers)
|
||||
(arguments `(#:guile ,%bootstrap-guile
|
||||
#:implicit-inputs? #f
|
||||
,@(package-arguments linux-libre-headers)))
|
||||
(native-inputs
|
||||
`(("perl" ,perl-boot0)
|
||||
,@%boot0-inputs)))))
|
||||
|
||||
(define texinfo-boot0
|
||||
;; Texinfo used to build libc's manual.
|
||||
;; We build without ncurses because it fails to build at this stage, and
|
||||
;; because we don't need the stand-alone Info reader.
|
||||
;; Also, use %BOOT0-INPUTS to avoid building Perl once more.
|
||||
(let ((texinfo (package (inherit texinfo)
|
||||
(inputs (alist-delete "ncurses" (package-inputs texinfo))))))
|
||||
(package-with-bootstrap-guile
|
||||
(package-with-explicit-inputs texinfo %boot0-inputs
|
||||
(current-source-location)
|
||||
#:guile %bootstrap-guile))))
|
||||
|
||||
(define %boot1-inputs
|
||||
;; 2nd stage inputs.
|
||||
`(("gcc" ,gcc-boot0)
|
||||
("binutils-cross" ,binutils-boot0)
|
||||
|
||||
;; Keep "binutils" here because the cross-gcc invokes `as', not the
|
||||
;; cross-`as'.
|
||||
,@%boot0-inputs))
|
||||
|
||||
(define glibc-final-with-bootstrap-bash
|
||||
;; The final libc, "cross-built". If everything went well, the resulting
|
||||
;; store path has no dependencies. Actually, the really-final libc is
|
||||
;; built just below; the only difference is that this one uses the
|
||||
;; bootstrap Bash.
|
||||
(package-with-bootstrap-guile
|
||||
(package (inherit glibc)
|
||||
(name "glibc-intermediate")
|
||||
(arguments
|
||||
`(#:guile ,%bootstrap-guile
|
||||
#:implicit-inputs? #f
|
||||
|
||||
,@(substitute-keyword-arguments (package-arguments glibc)
|
||||
((#:configure-flags flags)
|
||||
`(append (list ,(string-append "--host=" (boot-triplet))
|
||||
,(string-append "--build="
|
||||
(nix-system->gnu-triplet))
|
||||
|
||||
;; Build Sun/ONC RPC support. In particular,
|
||||
;; install rpc/*.h.
|
||||
"--enable-obsolete-rpc")
|
||||
,flags))
|
||||
((#:phases phases)
|
||||
`(alist-cons-before
|
||||
'configure 'pre-configure
|
||||
(lambda* (#:key inputs #:allow-other-keys)
|
||||
;; Don't clobber CPATH with the bootstrap libc.
|
||||
(setenv "NATIVE_CPATH" (getenv "CPATH"))
|
||||
(unsetenv "CPATH")
|
||||
|
||||
;; 'rpcgen' needs native libc headers to be built.
|
||||
(substitute* "sunrpc/Makefile"
|
||||
(("sunrpc-CPPFLAGS =.*" all)
|
||||
(string-append "CPATH = $(NATIVE_CPATH)\n"
|
||||
"export CPATH\n"
|
||||
all "\n"))))
|
||||
,phases)))))
|
||||
(propagated-inputs `(("linux-headers" ,(linux-libre-headers-boot0))))
|
||||
(native-inputs
|
||||
`(("texinfo" ,texinfo-boot0)
|
||||
("perl" ,perl-boot0)))
|
||||
(inputs
|
||||
`(;; The boot inputs. That includes the bootstrap libc. We don't want
|
||||
;; it in $CPATH, hence the 'pre-configure' phase above.
|
||||
,@%boot1-inputs
|
||||
|
||||
;; A native GCC is needed to build `cross-rpcgen'.
|
||||
("native-gcc" ,@(assoc-ref %boot0-inputs "gcc"))
|
||||
|
||||
;; Here, we use the bootstrap Bash, which is not satisfactory
|
||||
;; because we don't want to depend on bootstrap tools.
|
||||
("static-bash" ,@(assoc-ref %boot0-inputs "bash")))))))
|
||||
|
||||
(define (cross-gcc-wrapper gcc binutils glibc bash)
|
||||
"Return a wrapper for the pseudo-cross toolchain GCC/BINUTILS/GLIBC
|
||||
that makes it available under the native tool names."
|
||||
(package (inherit gcc-4.8)
|
||||
(name (string-append (package-name gcc) "-wrapped"))
|
||||
(source #f)
|
||||
(build-system trivial-build-system)
|
||||
(outputs '("out"))
|
||||
(arguments
|
||||
`(#:guile ,%bootstrap-guile
|
||||
#:modules ((guix build utils))
|
||||
#:builder (begin
|
||||
(use-modules (guix build utils))
|
||||
|
||||
(let* ((binutils (assoc-ref %build-inputs "binutils"))
|
||||
(gcc (assoc-ref %build-inputs "gcc"))
|
||||
(libc (assoc-ref %build-inputs "libc"))
|
||||
(bash (assoc-ref %build-inputs "bash"))
|
||||
(out (assoc-ref %outputs "out"))
|
||||
(bindir (string-append out "/bin"))
|
||||
(triplet ,(boot-triplet)))
|
||||
(define (wrap-program program)
|
||||
;; GCC-BOOT0 is a libc-less cross-compiler, so it
|
||||
;; needs to be told where to find the crt files and
|
||||
;; the dynamic linker.
|
||||
(call-with-output-file program
|
||||
(lambda (p)
|
||||
(format p "#!~a/bin/bash
|
||||
exec ~a/bin/~a-~a -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
|
||||
bash
|
||||
gcc triplet program
|
||||
libc libc
|
||||
,(glibc-dynamic-linker))))
|
||||
|
||||
(chmod program #o555))
|
||||
|
||||
(mkdir-p bindir)
|
||||
(with-directory-excursion bindir
|
||||
(for-each (lambda (tool)
|
||||
(symlink (string-append binutils "/bin/"
|
||||
triplet "-" tool)
|
||||
tool))
|
||||
'("ar" "ranlib"))
|
||||
(for-each wrap-program '("gcc" "g++")))))))
|
||||
(native-inputs
|
||||
`(("binutils" ,binutils)
|
||||
("gcc" ,gcc)
|
||||
("libc" ,glibc)
|
||||
("bash" ,bash)))
|
||||
(inputs '())))
|
||||
|
||||
(define static-bash-for-glibc
|
||||
;; A statically-linked Bash to be embedded in GLIBC-FINAL, for use by
|
||||
;; system(3) & co.
|
||||
(let* ((gcc (cross-gcc-wrapper gcc-boot0 binutils-boot0
|
||||
glibc-final-with-bootstrap-bash
|
||||
(car (assoc-ref %boot1-inputs "bash"))))
|
||||
(bash (package (inherit bash-light)
|
||||
(arguments
|
||||
`(#:guile ,%bootstrap-guile
|
||||
,@(package-arguments bash-light))))))
|
||||
(package-with-bootstrap-guile
|
||||
(package-with-explicit-inputs (static-package bash)
|
||||
`(("gcc" ,gcc)
|
||||
("libc" ,glibc-final-with-bootstrap-bash)
|
||||
,@(fold alist-delete %boot1-inputs
|
||||
'("gcc" "libc")))
|
||||
(current-source-location)))))
|
||||
|
||||
(define-public glibc-final
|
||||
;; The final glibc, which embeds the statically-linked Bash built above.
|
||||
(package (inherit glibc-final-with-bootstrap-bash)
|
||||
(name "glibc")
|
||||
(inputs `(("static-bash" ,static-bash-for-glibc)
|
||||
,@(alist-delete
|
||||
"static-bash"
|
||||
(package-inputs glibc-final-with-bootstrap-bash))))
|
||||
|
||||
;; The final libc only refers to itself, but the 'debug' output contains
|
||||
;; references to GCC-BOOT0 and to the Linux headers. XXX: Would be great
|
||||
;; if 'allowed-references' were per-output.
|
||||
(arguments
|
||||
`(#:allowed-references
|
||||
,(cons* `(,gcc-boot0 "lib") (linux-libre-headers-boot0)
|
||||
(package-outputs glibc-final-with-bootstrap-bash))
|
||||
|
||||
,@(package-arguments glibc-final-with-bootstrap-bash)))))
|
||||
|
||||
(define gcc-boot0-wrapped
|
||||
;; Make the cross-tools GCC-BOOT0 and BINUTILS-BOOT0 available under the
|
||||
;; non-cross names.
|
||||
(cross-gcc-wrapper gcc-boot0 binutils-boot0 glibc-final
|
||||
(car (assoc-ref %boot1-inputs "bash"))))
|
||||
|
||||
(define %boot2-inputs
|
||||
;; 3rd stage inputs.
|
||||
`(("libc" ,glibc-final)
|
||||
("gcc" ,gcc-boot0-wrapped)
|
||||
,@(fold alist-delete %boot1-inputs '("libc" "gcc"))))
|
||||
|
||||
(define binutils-final
|
||||
(package-with-bootstrap-guile
|
||||
(package (inherit binutils)
|
||||
(arguments
|
||||
`(#:guile ,%bootstrap-guile
|
||||
#:implicit-inputs? #f
|
||||
#:allowed-references ("out" ,glibc-final)
|
||||
,@(package-arguments binutils)))
|
||||
(inputs %boot2-inputs))))
|
||||
|
||||
(define libstdc++
|
||||
;; Intermediate libstdc++ that will allow us to build the final GCC
|
||||
;; (remember that GCC-BOOT0 cannot build libstdc++.)
|
||||
(package-with-bootstrap-guile
|
||||
(package (inherit gcc-4.8)
|
||||
(name "libstdc++")
|
||||
(arguments
|
||||
`(#:guile ,%bootstrap-guile
|
||||
#:implicit-inputs? #f
|
||||
|
||||
#:out-of-source? #t
|
||||
#:phases (alist-cons-before
|
||||
'configure 'chdir
|
||||
(lambda _
|
||||
(chdir "libstdc++-v3"))
|
||||
%standard-phases)
|
||||
#:configure-flags `("--disable-shared"
|
||||
"--disable-libstdcxx-threads"
|
||||
"--disable-libstdcxx-pch"
|
||||
,(string-append "--with-gxx-include-dir="
|
||||
(assoc-ref %outputs "out")
|
||||
"/include"
|
||||
;; "/include/c++/"
|
||||
;; ,(package-version gcc-4.8)
|
||||
))))
|
||||
(outputs '("out"))
|
||||
(inputs %boot2-inputs)
|
||||
(native-inputs '())
|
||||
(propagated-inputs '())
|
||||
(synopsis "GNU C++ standard library (intermediate)"))))
|
||||
|
||||
(define-public gcc-final
|
||||
;; The final GCC.
|
||||
(package (inherit gcc-boot0)
|
||||
(name "gcc")
|
||||
(location (source-properties->location (current-source-location)))
|
||||
(arguments
|
||||
`(#:guile ,%bootstrap-guile
|
||||
#:implicit-inputs? #f
|
||||
|
||||
#:allowed-references ("out" "lib" ,glibc-final)
|
||||
|
||||
;; Build again GMP & co. within GCC's build process, because it's hard
|
||||
;; to do outside (because GCC-BOOT0 is a cross-compiler, and thus
|
||||
;; doesn't honor $LIBRARY_PATH, which breaks `gnu-build-system'.)
|
||||
,@(substitute-keyword-arguments (package-arguments gcc-boot0)
|
||||
((#:configure-flags boot-flags)
|
||||
(let loop ((args (package-arguments gcc-4.8)))
|
||||
(match args
|
||||
((#:configure-flags normal-flags _ ...)
|
||||
normal-flags)
|
||||
((_ rest ...)
|
||||
(loop rest)))))
|
||||
((#:make-flags flags)
|
||||
;; Since $LIBRARY_PATH and $CPATH are not honored, add the
|
||||
;; relevant flags.
|
||||
`(cons (string-append "CPPFLAGS=-I"
|
||||
(assoc-ref %build-inputs "libstdc++")
|
||||
"/include")
|
||||
(map (lambda (flag)
|
||||
(if (string-prefix? "LDFLAGS=" flag)
|
||||
(string-append flag " -L"
|
||||
(assoc-ref %build-inputs "libstdc++")
|
||||
"/lib")
|
||||
flag))
|
||||
,flags)))
|
||||
((#:phases phases)
|
||||
`(alist-delete 'symlink-libgcc_eh ,phases)))))
|
||||
|
||||
;; This time we want Texinfo, so we get the manual.
|
||||
(native-inputs `(("texinfo" ,texinfo-boot0)
|
||||
,@(package-native-inputs gcc-boot0)))
|
||||
|
||||
(inputs `(("gmp-source" ,(package-source gmp))
|
||||
("mpfr-source" ,(package-source mpfr))
|
||||
("mpc-source" ,(package-source mpc))
|
||||
("binutils" ,binutils-final)
|
||||
("libstdc++" ,libstdc++)
|
||||
,@%boot2-inputs))))
|
||||
|
||||
(define ld-wrapper-boot3
|
||||
;; A linker wrapper that uses the bootstrap Guile.
|
||||
(package
|
||||
(name "ld-wrapper-boot3")
|
||||
(version "0")
|
||||
(source #f)
|
||||
(build-system trivial-build-system)
|
||||
(inputs `(("binutils" ,binutils-final)
|
||||
("guile" ,%bootstrap-guile)
|
||||
("bash" ,@(assoc-ref %boot2-inputs "bash"))
|
||||
("wrapper" ,(search-path %load-path
|
||||
"gnu/packages/ld-wrapper.scm"))))
|
||||
(arguments
|
||||
`(#:guile ,%bootstrap-guile
|
||||
#:modules ((guix build utils))
|
||||
#:builder (begin
|
||||
(use-modules (guix build utils)
|
||||
(system base compile))
|
||||
|
||||
(let* ((out (assoc-ref %outputs "out"))
|
||||
(bin (string-append out "/bin"))
|
||||
(ld (string-append bin "/ld"))
|
||||
(go (string-append bin "/ld.go")))
|
||||
|
||||
(setvbuf (current-output-port) _IOLBF)
|
||||
(format #t "building ~s/bin/ld wrapper in ~s~%"
|
||||
(assoc-ref %build-inputs "binutils")
|
||||
out)
|
||||
|
||||
(mkdir-p bin)
|
||||
(copy-file (assoc-ref %build-inputs "wrapper") ld)
|
||||
(substitute* ld
|
||||
(("@GUILE@")
|
||||
(string-append (assoc-ref %build-inputs "guile")
|
||||
"/bin/guile"))
|
||||
(("@BASH@")
|
||||
(string-append (assoc-ref %build-inputs "bash")
|
||||
"/bin/bash"))
|
||||
(("@LD@")
|
||||
(string-append (assoc-ref %build-inputs "binutils")
|
||||
"/bin/ld")))
|
||||
(chmod ld #o555)
|
||||
(compile-file ld #:output-file go)))))
|
||||
(synopsis "The linker wrapper")
|
||||
(description
|
||||
"The linker wrapper (or `ld-wrapper') wraps the linker to add any
|
||||
missing `-rpath' flags, and to detect any misuse of libraries outside of the
|
||||
store.")
|
||||
(home-page #f)
|
||||
(license gpl3+)))
|
||||
|
||||
(define %boot3-inputs
|
||||
;; 4th stage inputs.
|
||||
`(("gcc" ,gcc-final)
|
||||
("ld-wrapper" ,ld-wrapper-boot3)
|
||||
,@(alist-delete "gcc" %boot2-inputs)))
|
||||
|
||||
(define bash-final
|
||||
;; Link with `-static-libgcc' to make sure we don't retain a reference
|
||||
;; to the bootstrap GCC.
|
||||
(package-with-bootstrap-guile
|
||||
(package-with-explicit-inputs (static-libgcc-package bash)
|
||||
%boot3-inputs
|
||||
(current-source-location)
|
||||
#:guile %bootstrap-guile)))
|
||||
|
||||
(define %boot4-inputs
|
||||
;; Now use the final Bash.
|
||||
`(("bash" ,bash-final)
|
||||
,@(alist-delete "bash" %boot3-inputs)))
|
||||
|
||||
(define-public guile-final
|
||||
(package-with-bootstrap-guile
|
||||
(package-with-explicit-inputs guile-2.0/fixed
|
||||
%boot4-inputs
|
||||
(current-source-location)
|
||||
#:guile %bootstrap-guile)))
|
||||
|
||||
(define gnu-make-final
|
||||
;; The final GNU Make, which uses the final Guile.
|
||||
(package-with-bootstrap-guile
|
||||
(package-with-explicit-inputs gnu-make
|
||||
`(("guile" ,guile-final)
|
||||
,@%boot4-inputs)
|
||||
(current-source-location))))
|
||||
|
||||
(define-public ld-wrapper
|
||||
;; The final `ld' wrapper, which uses the final Guile.
|
||||
(package (inherit ld-wrapper-boot3)
|
||||
(name "ld-wrapper")
|
||||
(inputs `(("guile" ,guile-final)
|
||||
("bash" ,bash-final)
|
||||
,@(fold alist-delete (package-inputs ld-wrapper-boot3)
|
||||
'("guile" "bash"))))))
|
||||
|
||||
(define coreutils-final
|
||||
;; The final Coreutils. Treat them specially because some packages, such as
|
||||
;; Findutils, keep a reference to the Coreutils they were built with.
|
||||
(package-with-bootstrap-guile
|
||||
(package-with-explicit-inputs coreutils
|
||||
%boot4-inputs
|
||||
(current-source-location)
|
||||
|
||||
;; Use the final Guile, linked against the
|
||||
;; final libc with working iconv, so that
|
||||
;; 'substitute*' works well when touching
|
||||
;; test files in Gettext.
|
||||
#:guile guile-final)))
|
||||
|
||||
(define grep-final
|
||||
;; The final grep. Gzip holds a reference to it (via zgrep), so it must be
|
||||
;; built before gzip.
|
||||
(package-with-bootstrap-guile
|
||||
(package-with-explicit-inputs grep
|
||||
%boot4-inputs
|
||||
(current-source-location)
|
||||
#:guile guile-final)))
|
||||
|
||||
(define %boot5-inputs
|
||||
;; Now use the final Coreutils.
|
||||
`(("coreutils" ,coreutils-final)
|
||||
("grep" ,grep-final)
|
||||
,@%boot4-inputs))
|
||||
|
||||
(define-public %final-inputs
|
||||
;; Final derivations used as implicit inputs by 'gnu-build-system'. We
|
||||
;; still use 'package-with-bootstrap-guile' so that the bootstrap tools are
|
||||
;; used for origins that have patches, thereby avoiding circular
|
||||
;; dependencies.
|
||||
(let ((finalize (compose package-with-bootstrap-guile
|
||||
(cut package-with-explicit-inputs <> %boot5-inputs
|
||||
(current-source-location)))))
|
||||
`(,@(map (match-lambda
|
||||
((name package)
|
||||
(list name (finalize package))))
|
||||
`(("tar" ,tar)
|
||||
("gzip" ,gzip)
|
||||
("bzip2" ,bzip2)
|
||||
("xz" ,xz)
|
||||
("diffutils" ,diffutils)
|
||||
("patch" ,patch)
|
||||
("sed" ,sed)
|
||||
("findutils" ,findutils)
|
||||
("gawk" ,gawk)))
|
||||
("grep" ,grep-final)
|
||||
("coreutils" ,coreutils-final)
|
||||
("make" ,gnu-make-final)
|
||||
("bash" ,bash-final)
|
||||
("ld-wrapper" ,ld-wrapper)
|
||||
("binutils" ,binutils-final)
|
||||
("gcc" ,gcc-final)
|
||||
("libc" ,glibc-final))))
|
||||
|
||||
(define-public canonical-package
|
||||
(let ((name->package (fold (lambda (input result)
|
||||
(match input
|
||||
((_ package)
|
||||
(vhash-cons (package-full-name package)
|
||||
package result))))
|
||||
vlist-null
|
||||
`(("guile" ,guile-final)
|
||||
,@%final-inputs))))
|
||||
(lambda (package)
|
||||
"Return the 'canonical' variant of PACKAGE---i.e., if PACKAGE is one of
|
||||
the implicit inputs of 'gnu-build-system', return that one, otherwise return
|
||||
PACKAGE.
|
||||
|
||||
The goal is to avoid duplication in cases like GUILE-FINAL vs. GUILE-2.0,
|
||||
COREUTILS-FINAL vs. COREUTILS, etc."
|
||||
;; XXX: This doesn't handle dependencies of the final inputs, such as
|
||||
;; libunistring, GMP, etc.
|
||||
(match (vhash-assoc (package-full-name package) name->package)
|
||||
((_ . canon)
|
||||
;; In general we want CANON, except if we're cross-compiling: CANON
|
||||
;; uses explicit inputs, so it is "anchored" in the bootstrapped
|
||||
;; process, with dependencies on things that cannot be
|
||||
;; cross-compiled.
|
||||
(if (%current-target-system)
|
||||
package
|
||||
canon))
|
||||
(_ package)))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; GCC toolchain.
|
||||
;;;
|
||||
|
||||
(define (gcc-toolchain gcc)
|
||||
"Return a complete toolchain for GCC."
|
||||
(package
|
||||
(name "gcc-toolchain")
|
||||
(version (package-version gcc))
|
||||
(source #f)
|
||||
(build-system trivial-build-system)
|
||||
(arguments
|
||||
'(#:modules ((guix build union))
|
||||
#:builder (begin
|
||||
(use-modules (ice-9 match)
|
||||
(guix build union))
|
||||
|
||||
(match %build-inputs
|
||||
(((names . directories) ...)
|
||||
(union-build (assoc-ref %outputs "out")
|
||||
directories)))
|
||||
|
||||
(union-build (assoc-ref %outputs "debug")
|
||||
(list (assoc-ref %build-inputs
|
||||
"libc-debug"))))))
|
||||
(license (package-license gcc))
|
||||
(synopsis "Complete GCC tool chain for C/C++ development")
|
||||
(description
|
||||
"This package provides a complete GCC tool chain for C/C++ development to
|
||||
be installed in user profiles. This includes GCC, as well as libc (headers
|
||||
and binaries, plus debugging symbols in the 'debug' output), and Binutils.")
|
||||
(home-page "http://gcc.gnu.org/")
|
||||
(outputs '("out" "debug"))
|
||||
|
||||
;; The main raison d'être of this "meta-package" is (1) to conveniently
|
||||
;; install everything that we need, and (2) to make sure ld-wrapper comes
|
||||
;; before Binutils' ld in the user's profile.
|
||||
(inputs `(("gcc" ,gcc)
|
||||
("ld-wrapper" ,(car (assoc-ref %final-inputs "ld-wrapper")))
|
||||
("binutils" ,binutils-final)
|
||||
("libc" ,glibc-final)
|
||||
("libc-debug" ,glibc-final "debug")))))
|
||||
|
||||
(define-public gcc-toolchain-4.8
|
||||
(gcc-toolchain gcc-final))
|
||||
|
||||
(define-public gcc-toolchain-4.9
|
||||
(gcc-toolchain gcc-4.9))
|
||||
(define-public (canonical-package package)
|
||||
;; Avoid circular dependency by lazily resolving 'commencement'.
|
||||
(let* ((iface (resolve-interface '(gnu packages commencement)))
|
||||
(proc (module-ref iface 'canonical-package)))
|
||||
(proc package)))
|
||||
|
||||
;;; base.scm ends here
|
||||
|
||||
+92
-6
@@ -1,5 +1,6 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -20,10 +21,85 @@
|
||||
#:use-module (guix licenses)
|
||||
#:use-module (gnu packages ncurses)
|
||||
#:use-module (gnu packages readline)
|
||||
#:use-module (gnu packages bison)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix utils)
|
||||
#:use-module (guix build-system gnu))
|
||||
#:use-module (guix build-system gnu)
|
||||
#:autoload (guix gnupg) (gnupg-verify*)
|
||||
#:autoload (guix hash) (port-sha256)
|
||||
#:autoload (guix base32) (bytevector->nix-base32-string)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (ice-9 format))
|
||||
|
||||
(define (patch-url seqno)
|
||||
"Return the URL of Bash patch number SEQNO."
|
||||
(format #f "mirror://gnu/bash/bash-4.3-patches/bash43-~3,'0d" seqno))
|
||||
|
||||
(define (bash-patch seqno sha256)
|
||||
"Return the origin of Bash patch SEQNO, with expected hash SHA256"
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (patch-url seqno))
|
||||
(sha256 sha256)))
|
||||
|
||||
(define-syntax-rule (patch-series (seqno hash) ...)
|
||||
(list (bash-patch seqno (base32 hash))
|
||||
...))
|
||||
|
||||
(define %patch-series-4.3
|
||||
;; This is the current patches series for 4.3, generated using
|
||||
;; 'download-patches' below.
|
||||
(patch-series
|
||||
(1 "0hip2n2s5hws8p4nfcz37379zn6cak83ljsm64z52rw6ckrdzczc")
|
||||
(2 "0ashj5d1g3zbyr7zf0r72s5wnk96cz1xj919y3jajadbc9qcvrzf")
|
||||
(3 "0z88q4daq7dmw93iqd9c5i5d1sndklih3nrh0v75746da2n6w3h0")
|
||||
(4 "0f0kh9j5k4ym6knshscx31przm50x5cc7ifkwqk0swh6clna982y")
|
||||
(5 "1ym3b8b7lgmdp3dklp8qaqhyq965wd5392namq8mz7rb0d231j0s")
|
||||
(6 "04q20igq49py49ynb0f83f6f52cdkyqwd9bpic6akr0m5pkqwr50")
|
||||
(7 "18zkz23d9myshrwfcwcdjk7qmkqp8az5n91ni9jaixlwqlhy64qi")
|
||||
(8 "0pprcwvh7ngdli0x95pc1cpssg4qg7layi9xrv2jq6c7965ajhcr")
|
||||
(9 "19a0pf0alp30d1bjj0zf3zq2f5n0s6y91w7brm9jyswl51kns8n0")
|
||||
(10 "1dzhr5ammyijisz48cqi5vaw26hfr5vh9smnqxq4qc9p06f7j1ff")
|
||||
(11 "0fvzdzzi142a8rf3v965r6gbpn0k7fv2gif1yq8a4160vcn40qvw")
|
||||
(12 "04lcgfcyz7p3zagb4hkia3hkpd7lii9m8ycy9qqwzyrm1c1pj4ry")
|
||||
(13 "0y9cqi378z6flapkd5k5lfl4lq3ivzg4njj3i3wmw7xb6r9wma5z")
|
||||
(14 "04xcb0k9fxxq4vashgzb98567xzdnm4655nlm4jvfvjv6si6ykas")
|
||||
(15 "13ay6lldy1p00xj41nfjpq8lai3vw2qwca79gx6s80z04j53wa8k")
|
||||
(16 "0wq7bvx3pfw90pnfb86yg5nr9jgjsvm2nq5rrkqxf6zn977hpmlj")
|
||||
(17 "103p7sibihv6cshqj12k546zsbz0dnd5cv5vlx1719avddfc4rqj")
|
||||
(18 "0n1x3812y1brb9xbabaj3fvr4cpvm2225iwckmqk2fcpkq5b9a3s")
|
||||
(19 "08rd1p7zpzgbpmmmnj2im8wj2pcwmbbx51psr9vdc5c049si9ad7")
|
||||
(20 "163c6g05qpag2plx5q795pmw3f3m904jy7z93xj2i08pgzc8cpna")
|
||||
(21 "1a90cl3h10dh8k9f2ddrsjmw5ywaw2d5x78xb4fd2sryi039yhs1")
|
||||
(22 "120s0s4qcqd0q12j1iv0hkpf9fp3w5jnqw646kv66n66jnxlfkgx")
|
||||
(23 "1m00sfi88p2akgiyrg4hw0gvz3s1586pkzjdr3dm73vs773m1hls")
|
||||
(24 "0v0gjqzjsqjfgj5x17fq7g649k94jn8zq92qsxkhc2d6l215hl1v")
|
||||
(25 "0lcj96i659q35f1jcmwwbnw3p7w7vvlxjxqi989vn6d6qksqcl8y") ;CVE-2014-6271
|
||||
(26 "0k919ir0inwn4wai2vdzpbwqq5h54fnrlkmgccxjg91v3ch15k1f") ;CVE-2014-7169
|
||||
(27 "1gnsfvq6bhb3srlbh0cannj2hackdsipcg7z0ds7zlk1hp96mdqy")
|
||||
(28 "17a65c4fn4c5rgsiw9gqqnzhznh3gwnd2xzzv2dppyi48znxpc78") ;CVE-2014-7186
|
||||
(29 "14k27p28r5l2fz3r03kd0x72vvsq8bja8c6hjz5kxikbzsbs7i2c") ;CVE-2014-6277
|
||||
(30 "0nrqb0m7s89qsrbfaffpilc5gcf82bx9yvgzld4hr79p5y54yhw5"))) ;CVE-2014-6278
|
||||
|
||||
(define (download-patches store count)
|
||||
"Download COUNT Bash patches into store. Return a list of
|
||||
number/base32-hash tuples, directly usable in the 'patch-series' form."
|
||||
(unfold (cut > <> count)
|
||||
(lambda (number)
|
||||
(let* ((patch (download-to-store store (patch-url number)))
|
||||
(sig (download-to-store store
|
||||
(string-append (patch-url number)
|
||||
".sig"))))
|
||||
(unless (gnupg-verify* sig patch)
|
||||
(error "failed to verify signature" patch))
|
||||
|
||||
(list number
|
||||
(bytevector->nix-base32-string
|
||||
(call-with-input-file patch port-sha256)))))
|
||||
1+
|
||||
1))
|
||||
|
||||
(define-public bash
|
||||
(let* ((cppflags (string-join '("-DSYS_BASHRC='\"/etc/bashrc\"'"
|
||||
@@ -48,20 +124,30 @@
|
||||
;; Add a `bash' -> `sh' link.
|
||||
(let ((out (assoc-ref outputs "out")))
|
||||
(with-directory-excursion (string-append out "/bin")
|
||||
(symlink "bash" "sh"))))))
|
||||
(symlink "bash" "sh")))))
|
||||
(version "4.3"))
|
||||
(package
|
||||
(name "bash")
|
||||
(version "4.3")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
"mirror://gnu/bash/bash-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1m14s1f61mf6bijfibcjm9y6pkyvz6gibyl8p4hxq90fisi8gimg"))))
|
||||
"1m14s1f61mf6bijfibcjm9y6pkyvz6gibyl8p4hxq90fisi8gimg"))
|
||||
(patch-flags '("-p0"))
|
||||
(patches %patch-series-4.3)
|
||||
|
||||
;; The patches above modify 'parse.y', so force a rebuild of the
|
||||
;; parser.
|
||||
(snippet '(for-each delete-file
|
||||
'("y.tab.c" "y.tab.h" "parser-built")))))
|
||||
(version (string-append version "."
|
||||
(number->string (length %patch-series-4.3))))
|
||||
(build-system gnu-build-system)
|
||||
(native-inputs `(("bison" ,bison))) ;to rebuild the parser
|
||||
(inputs `(("readline" ,readline)
|
||||
("ncurses" ,ncurses))) ; TODO: add texinfo
|
||||
("ncurses" ,ncurses))) ;TODO: add texinfo
|
||||
(arguments
|
||||
`(;; When cross-compiling, `configure' incorrectly guesses that job
|
||||
;; control is missing.
|
||||
|
||||
@@ -1,68 +0,0 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2012 Andreas Enge <andreas@enge.fr>
|
||||
;;;
|
||||
;;; 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 bdb)
|
||||
#:use-module (gnu packages)
|
||||
#:use-module (guix licenses)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix build-system gnu))
|
||||
|
||||
(define-public bdb
|
||||
(package
|
||||
(name "bdb")
|
||||
(version "5.3.21")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "http://download.oracle.com/berkeley-db/db-" version
|
||||
".tar.gz"))
|
||||
(sha256 (base32
|
||||
"1f2g2612lf8djbwbwhxsvmffmf9d7693kh2l20195pqp0f9jmnfx"))))
|
||||
(build-system gnu-build-system)
|
||||
(outputs '("out" ; programs, libraries, headers
|
||||
"doc")) ; 94 MiB of HTML docs
|
||||
(arguments
|
||||
'(#:tests? #f ; no check target available
|
||||
#:phases
|
||||
(alist-replace
|
||||
'configure
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(let ((out (assoc-ref outputs "out"))
|
||||
(doc (assoc-ref outputs "doc")))
|
||||
;; '--docdir' is not honored, so we need to patch.
|
||||
(substitute* "dist/Makefile.in"
|
||||
(("docdir[[:blank:]]*=.*")
|
||||
(string-append "docdir = " doc "/share/doc/bdb")))
|
||||
|
||||
(zero?
|
||||
(system* "./dist/configure"
|
||||
(string-append "--prefix=" out)
|
||||
(string-append "CONFIG_SHELL=" (which "bash"))
|
||||
(string-append "SHELL=" (which "bash"))
|
||||
|
||||
;; The compatibility mode is needed by some packages,
|
||||
;; notably iproute2.
|
||||
"--enable-compat185"))))
|
||||
%standard-phases)))
|
||||
(synopsis "db, the Berkeley database")
|
||||
(description
|
||||
"Berkeley DB is an embeddable database allowing developers the choice of
|
||||
SQL, Key/Value, XML/XQuery or Java Object storage for their data model.")
|
||||
(license (bsd-style "file://LICENSE"
|
||||
"See LICENSE in the distribution."))
|
||||
(home-page "http://www.oracle.com/us/products/database/berkeley-db/overview/index.html")))
|
||||
@@ -1,5 +1,6 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -26,14 +27,14 @@
|
||||
(define-public libgc-7.2
|
||||
(package
|
||||
(name "libgc")
|
||||
(version "7.2e")
|
||||
(version "7.2f")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "http://www.hboehm.info/gc/gc_source/gc-"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0jxgr71rhk58dzc1ihqs51vldh2qs1m154bn41qh6q1dm145nc89"))))
|
||||
"119x7p1cqw40mpwj80xfq879l9m1dkc7vbc1f3bz3kvkf8bf6p16"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
;; Make it so that we don't rely on /proc. This is especially useful in
|
||||
@@ -64,15 +65,15 @@ C or C++ programs, though that is not its primary goal.")
|
||||
(define-public libatomic-ops
|
||||
(package
|
||||
(name "libatomic-ops")
|
||||
(version "7.4.0")
|
||||
(version "7.4.2")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
"http://www.hboehm.info/gc/gc_source/libatomic_ops-"
|
||||
"http://www.ivmaisoft.com/_bin/atomic_ops/libatomic_ops-"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0njv3n63zw6v45k68z6dz14g2hpk5p230ncwmdfkglsljb1cqx98"))))
|
||||
"1pdm0h1y7bgkczr8byg20r6bq15m5072cqm5pny4f9crc9gn3yh4"))))
|
||||
(build-system gnu-build-system)
|
||||
(outputs '("out" "debug"))
|
||||
(synopsis "Accessing hardware atomic memory update operations")
|
||||
@@ -88,14 +89,14 @@ lock-free code, experiment with thread programming paradigms, etc.")
|
||||
|
||||
(define-public libgc
|
||||
(package (inherit libgc-7.2)
|
||||
(version "7.4.0")
|
||||
(version "7.4.2")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "http://www.hboehm.info/gc/gc_source/gc-"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"10z2nph62ilab063wygg2lv0jxlsbcf2az9w1lx01jzqj5lzry31"))))
|
||||
"18mg28rr6kwr5clc65k4l4hkyy4kd16amx831sjf8q2lqkbhlck3"))))
|
||||
|
||||
;; New dependencies.
|
||||
(native-inputs `(("pkg-config" ,pkg-config)))
|
||||
|
||||
@@ -51,3 +51,16 @@ deterministic or generalized LR parser from an annotated, context-free
|
||||
grammar. It is versatile enough to have many applications, from parsers for
|
||||
simple tools through complex programming languages.")
|
||||
(license gpl3+)))
|
||||
|
||||
(define-public bison-2.7
|
||||
(package (inherit bison)
|
||||
(version "2.7")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnu/bison/bison-"
|
||||
version ".tar.xz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1zd77ilmpv5mi3kr55jrj6ncqlcnyhpianhrwzak2q28cv2cbn23"))))))
|
||||
|
||||
|
||||
@@ -20,8 +20,7 @@
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module ((guix licenses)
|
||||
#:renamer (symbol-prefix-proc 'l:))
|
||||
#:use-module ((guix licenses) #:prefix l:)
|
||||
#:use-module (gnu packages openssl)
|
||||
#:use-module (gnu packages libevent)
|
||||
#:use-module (gnu packages curl)
|
||||
@@ -36,7 +35,7 @@
|
||||
(define-public transmission
|
||||
(package
|
||||
(name "transmission")
|
||||
(version "2.83")
|
||||
(version "2.84")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
@@ -44,7 +43,7 @@
|
||||
version ".tar.xz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0cqlgl6jmjw1caybz6nzh3l8z0jak1dxba01isv72zvy2r8b1qdh"))))
|
||||
"1sxr1magqb5s26yvr5yhs1f7bmir8gl09niafg64lhgfnhv1kz59"))))
|
||||
(build-system gnu-build-system)
|
||||
(outputs '("out" ; library and command-line interface
|
||||
"gui")) ; graphical user interface
|
||||
|
||||
+42
-31
@@ -1,5 +1,6 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2014 John Darrington <jmd@gnu.org>
|
||||
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -17,12 +18,12 @@
|
||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gnu packages boost)
|
||||
#:use-module ((guix licenses)
|
||||
#:renamer (symbol-prefix-proc 'license:))
|
||||
#:use-module ((guix licenses) #:prefix license:)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (gnu packages)
|
||||
#:use-module (gnu packages compression)
|
||||
#:use-module (gnu packages python)
|
||||
#:use-module (gnu packages tcsh)
|
||||
#:use-module (gnu packages perl))
|
||||
@@ -41,44 +42,54 @@
|
||||
(base32
|
||||
"0lkv5dzssbl5fmh2nkaszi8x9qbj80pr4acf9i26sj3rvlih1w7z"))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs `(("zlib" ,zlib)))
|
||||
(native-inputs
|
||||
`(("perl" ,perl)
|
||||
("python" ,python-2)
|
||||
("tcsh" ,tcsh)))
|
||||
(arguments
|
||||
`(#:phases
|
||||
(alist-replace
|
||||
'configure
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(let ((out (assoc-ref outputs "out")))
|
||||
(substitute* '("libs/config/configure"
|
||||
"libs/spirit/classic/phoenix/test/runtest.sh"
|
||||
"tools/build/v2/doc/bjam.qbk"
|
||||
"tools/build/v2/engine/execunix.c"
|
||||
"tools/build/v2/engine/Jambase"
|
||||
"tools/build/v2/engine/jambase.c")
|
||||
(("/bin/sh") (which "sh")))
|
||||
|
||||
(setenv "SHELL" (which "sh"))
|
||||
(setenv "CONFIG_SHELL" (which "sh"))
|
||||
|
||||
(zero? (system* "./bootstrap.sh"
|
||||
(string-append "--prefix=" out)
|
||||
"--with-toolset=gcc"))))
|
||||
(alist-replace
|
||||
'build
|
||||
(lambda _
|
||||
(zero? (system* "./b2" "threading=multi" "link=shared")))
|
||||
|
||||
(let ((build-flags
|
||||
`("threading=multi" "link=shared"
|
||||
;; Boost's 'context' library is not yet supported on mips64, so
|
||||
;; we disable it. The 'coroutine' library depends on 'context',
|
||||
;; so we disable that too.
|
||||
,@(if (equal? "mips64el-linux" (or (%current-target-system)
|
||||
(%current-system)))
|
||||
'("--without-context" "--without-coroutine")
|
||||
'()))))
|
||||
`(#:phases
|
||||
(alist-replace
|
||||
'check
|
||||
(lambda _ #t)
|
||||
'configure
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(let ((out (assoc-ref outputs "out")))
|
||||
(substitute* '("libs/config/configure"
|
||||
"libs/spirit/classic/phoenix/test/runtest.sh"
|
||||
"tools/build/v2/doc/bjam.qbk"
|
||||
"tools/build/v2/engine/execunix.c"
|
||||
"tools/build/v2/engine/Jambase"
|
||||
"tools/build/v2/engine/jambase.c")
|
||||
(("/bin/sh") (which "sh")))
|
||||
|
||||
(setenv "SHELL" (which "sh"))
|
||||
(setenv "CONFIG_SHELL" (which "sh"))
|
||||
|
||||
(zero? (system* "./bootstrap.sh"
|
||||
(string-append "--prefix=" out)
|
||||
"--with-toolset=gcc"))))
|
||||
(alist-replace
|
||||
'install
|
||||
'build
|
||||
(lambda _
|
||||
(zero? (system* "./b2" "install" "threading=multi" "link=shared")))
|
||||
%standard-phases))))))
|
||||
(zero? (system* "./b2" ,@build-flags)))
|
||||
|
||||
(alist-replace
|
||||
'check
|
||||
(lambda _ #t)
|
||||
|
||||
(alist-replace
|
||||
'install
|
||||
(lambda _
|
||||
(zero? (system* "./b2" "install" ,@build-flags)))
|
||||
%standard-phases)))))))
|
||||
|
||||
(home-page "http://boost.org")
|
||||
(synopsis "Peer-reviewed portable C++ source libraries")
|
||||
|
||||
+62
-36
@@ -1,5 +1,5 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -78,7 +78,14 @@
|
||||
(boot url-fetch))
|
||||
(else orig-method)))
|
||||
(patch-guile %bootstrap-guile)
|
||||
(patch-inputs %bootstrap-patch-inputs))))
|
||||
(patch-inputs %bootstrap-patch-inputs)
|
||||
|
||||
;; Patches can be origins as well, so process them.
|
||||
(patches (map (match-lambda
|
||||
((? origin? patch)
|
||||
(bootstrap-origin patch))
|
||||
(patch patch))
|
||||
(origin-patches source))))))
|
||||
|
||||
(define (package-from-tarball name source program-to-test description)
|
||||
"Return a package that correspond to the extraction of SOURCE.
|
||||
@@ -139,7 +146,9 @@ check whether everything is alright."
|
||||
(native-inputs (map rewritten-input
|
||||
(package-native-inputs p)))
|
||||
(propagated-inputs (map rewritten-input
|
||||
(package-propagated-inputs p)))))))
|
||||
(package-propagated-inputs p)))
|
||||
(replacement (and=> (package-replacement p)
|
||||
package-with-bootstrap-guile))))))
|
||||
|
||||
(define* (glibc-dynamic-linker
|
||||
#:optional (system (or (and=> (%current-target-system)
|
||||
@@ -149,6 +158,11 @@ check whether everything is alright."
|
||||
(cond ((string=? system "x86_64-linux") "/lib/ld-linux-x86-64.so.2")
|
||||
((string=? system "i686-linux") "/lib/ld-linux.so.2")
|
||||
((string=? system "mips64el-linux") "/lib/ld.so.1")
|
||||
|
||||
;; XXX: This one is used bare-bones, without a libc, so add a case
|
||||
;; here just so we can keep going.
|
||||
((string=? system "xtensa-elf") "no-ld.so")
|
||||
|
||||
(else (error "dynamic linker name not known for this system"
|
||||
system))))
|
||||
|
||||
@@ -157,6 +171,48 @@ check whether everything is alright."
|
||||
;;; Bootstrap packages.
|
||||
;;;
|
||||
|
||||
(define* (raw-build store name inputs
|
||||
#:key outputs system search-paths
|
||||
#:allow-other-keys)
|
||||
(define (->store file)
|
||||
(add-to-store store file #t "sha256"
|
||||
(or (search-bootstrap-binary file
|
||||
system)
|
||||
(error "bootstrap binary not found"
|
||||
file system))))
|
||||
|
||||
(let* ((tar (->store "tar"))
|
||||
(xz (->store "xz"))
|
||||
(mkdir (->store "mkdir"))
|
||||
(bash (->store "bash"))
|
||||
(guile (->store "guile-2.0.9.tar.xz"))
|
||||
(builder
|
||||
(add-text-to-store store
|
||||
"build-bootstrap-guile.sh"
|
||||
(format #f "
|
||||
echo \"unpacking bootstrap Guile to '$out'...\"
|
||||
~a $out
|
||||
cd $out
|
||||
~a -dc < ~a | ~a xv
|
||||
|
||||
# Sanity check.
|
||||
$out/bin/guile --version~%"
|
||||
mkdir xz guile tar)
|
||||
(list mkdir xz guile tar))))
|
||||
(derivation store name
|
||||
bash `(,builder)
|
||||
#:system system
|
||||
#:inputs `((,bash) (,builder)))))
|
||||
|
||||
(define* (make-raw-bag name
|
||||
#:key source inputs native-inputs outputs
|
||||
system target)
|
||||
(bag
|
||||
(name name)
|
||||
(system system)
|
||||
(build-inputs inputs)
|
||||
(build raw-build)))
|
||||
|
||||
(define %bootstrap-guile
|
||||
;; The Guile used to run the build scripts of the initial derivations.
|
||||
;; It is just unpacked from a tarball containing a pre-built binary.
|
||||
@@ -165,39 +221,9 @@ check whether everything is alright."
|
||||
;; XXX: Would need libc's `libnss_files2.so' for proper `getaddrinfo'
|
||||
;; support (for /etc/services).
|
||||
(let ((raw (build-system
|
||||
(name "raw")
|
||||
(description "Raw build system with direct store access")
|
||||
(build (lambda* (store name source inputs
|
||||
#:key outputs system search-paths)
|
||||
(define (->store file)
|
||||
(add-to-store store file #t "sha256"
|
||||
(or (search-bootstrap-binary file
|
||||
system)
|
||||
(error "bootstrap binary not found"
|
||||
file system))))
|
||||
|
||||
(let* ((tar (->store "tar"))
|
||||
(xz (->store "xz"))
|
||||
(mkdir (->store "mkdir"))
|
||||
(bash (->store "bash"))
|
||||
(guile (->store "guile-2.0.9.tar.xz"))
|
||||
(builder
|
||||
(add-text-to-store store
|
||||
"build-bootstrap-guile.sh"
|
||||
(format #f "
|
||||
echo \"unpacking bootstrap Guile to '$out'...\"
|
||||
~a $out
|
||||
cd $out
|
||||
~a -dc < ~a | ~a xv
|
||||
|
||||
# Sanity check.
|
||||
$out/bin/guile --version~%"
|
||||
mkdir xz guile tar)
|
||||
(list mkdir xz guile tar))))
|
||||
(derivation store name
|
||||
bash `(,builder)
|
||||
#:system system
|
||||
#:inputs `((,bash) (,builder)))))))))
|
||||
(name 'raw)
|
||||
(description "Raw build system with direct store access")
|
||||
(lower make-raw-bag))))
|
||||
(package
|
||||
(name "guile-bootstrap")
|
||||
(version "2.0")
|
||||
|
||||
@@ -27,7 +27,7 @@
|
||||
(define-public calcurse
|
||||
(package
|
||||
(name "calcurse")
|
||||
(version "3.1.4")
|
||||
(version "3.2.1")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
@@ -35,15 +35,15 @@
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1qwhffwhfg7bjxrviwlcrhnfw0976d39da8kfspq6dgd9nqv68a1"))))
|
||||
"0g92c4x02iv2wi3c1sm3nz1ay96bi2m7klxq3qyyx3pr11l53m85"))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs `(("ncurses" ,ncurses)))
|
||||
(home-page "http://www.calcurse.org")
|
||||
(synopsis "Text-based calendar and scheduling")
|
||||
(description
|
||||
"Calcurse is a text-based calendar and scheduling application. It helps
|
||||
keep track of events, appointments and everyday tasks. A configurable
|
||||
"Calcurse is a text-based calendar and scheduling application. It helps
|
||||
keep track of events, appointments and everyday tasks. A configurable
|
||||
notification system reminds user of upcoming deadlines, and the curses based
|
||||
interface can be customized to suit user needs. All of the commands are
|
||||
interface can be customized to suit user needs. All of the commands are
|
||||
documented within an online help system.")
|
||||
(license bsd-2)))
|
||||
|
||||
@@ -28,7 +28,7 @@
|
||||
(define-public ccache
|
||||
(package
|
||||
(name "ccache")
|
||||
(version "3.1.9")
|
||||
(version "3.1.10")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
@@ -36,8 +36,7 @@
|
||||
version ".tar.xz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1i06015jjc0n55xgvhv2h37fjp0i7z8a10s0v40f87c5mprzv0a9"))
|
||||
(patches (list (search-patch "ccache-stdc-predef-test.patch")))))
|
||||
"0mr8n1nbykxw4rs55ad8wd6xmfhihn09mxpxb91sn9mlsd1ryhw8"))))
|
||||
(build-system gnu-build-system)
|
||||
(native-inputs `(("perl" ,perl))) ;for test.sh
|
||||
(inputs `(("zlib" ,zlib)))
|
||||
|
||||
@@ -50,7 +50,7 @@
|
||||
(home-page "http://libcddb.sourceforge.net/")
|
||||
(synopsis "C library to access data on a CDDB server")
|
||||
(description
|
||||
"Libcddb is a C library to access data on a CDDB server (freedb.org). It
|
||||
"Libcddb is a C library to access data on a CDDB server (freedb.org). It
|
||||
allows you to:
|
||||
|
||||
1. search the database for possible CD matches;
|
||||
@@ -60,8 +60,8 @@ allows you to:
|
||||
3. submit new CD entries to the database.
|
||||
|
||||
Libcddb supports both the custom CDDB protocol and tunnelling the query and
|
||||
read operations over plain HTTP. It is also possible to use an HTTP proxy
|
||||
server. If you want to speed things up, you can make use of the built-in
|
||||
read operations over plain HTTP. It is also possible to use an HTTP proxy
|
||||
server. If you want to speed things up, you can make use of the built-in
|
||||
caching facility provided by the library.")
|
||||
(license lgpl2.1+)))
|
||||
|
||||
@@ -160,10 +160,10 @@ files.")
|
||||
(find-files "bin" ".*")))))
|
||||
%standard-phases)))
|
||||
(home-page "http://www.xiph.org/paranoia/")
|
||||
(synopsis "audio CD reading utility which includes extra data verification features")
|
||||
(synopsis "Audio CD reading utility")
|
||||
(description "Cdparanoia retrieves audio tracks from CDDA capable CDROM
|
||||
drives. The data can be saved to a file or directed to standard output
|
||||
in WAV, AIFF, AIFF-C or raw format. Most ATAPI, SCSI and several
|
||||
in WAV, AIFF, AIFF-C or raw format. Most ATAPI, SCSI and several
|
||||
proprietary CDROM drive makes are supported; cdparanoia can determine if the
|
||||
target drive is CDDA capable. In addition to simple reading, cdparanoia adds
|
||||
extra-robust data verification, synchronization, error handling and scratch
|
||||
@@ -201,7 +201,7 @@ reconstruction capability.")
|
||||
(delete-file ".#GNUmakefile"))
|
||||
%standard-phases)))
|
||||
(home-page "http://dvdisaster.net/en/index.html")
|
||||
(synopsis "error correcting codes for optical media images")
|
||||
(synopsis "Error correcting codes for optical media images")
|
||||
(description "Optical media (CD,DVD,BD) keep their data only for a
|
||||
finite time (typically for many years). After that time, data loss develops
|
||||
slowly with read errors growing from the outer media region towards the
|
||||
|
||||
+26
-3
@@ -37,12 +37,35 @@
|
||||
"1jcahzrvxcnp5chdn2x46l0y4aba8d8yd70lljfin7h5knxrlyhs"))))
|
||||
(build-system gnu-build-system)
|
||||
(home-page "http://check.sourceforge.net/")
|
||||
(synopsis "Check, a unit testing framework for C")
|
||||
(synopsis "Unit test framework for C")
|
||||
(description
|
||||
"Check is a unit testing framework for C. It features a simple
|
||||
"Check is a unit testing framework for C. It features a simple
|
||||
interface for defining unit tests, putting little in the way of the
|
||||
developer. Tests are run in a separate address space, so Check can
|
||||
catch both assertion failures and code errors that cause segmentation
|
||||
faults or other signals. The output from unit tests can be used within
|
||||
faults or other signals. The output from unit tests can be used within
|
||||
source code editors and IDEs.")
|
||||
(license lgpl2.1+)))
|
||||
|
||||
|
||||
(define-public cppunit
|
||||
(package
|
||||
(name "cppunit")
|
||||
(version "1.12.1")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://sourceforge/cppunit/" name "/"
|
||||
name "-"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0jm49v5rmc5qw34vqs56gy8xja1dhci73bmh23cig4kcir6a0a5c"))))
|
||||
(build-system gnu-build-system)
|
||||
(home-page "http://sourceforge.net/projects/cppunit/")
|
||||
(synopsis "Unit testing framework for C++")
|
||||
(description "CppUnit is the C++ port of the famous JUnit framework for
|
||||
unit testing. Test output is in XML for automatic testing and GUI based for
|
||||
supervised tests.")
|
||||
(license lgpl2.1))) ; no copyright notices. LGPL2.1 is in the tarball
|
||||
|
||||
|
||||
|
||||
+49
-29
@@ -1,6 +1,8 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
|
||||
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
|
||||
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
|
||||
;;; Copyright © 2014 Ian Denhardt <ian@zenhack.net>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -18,13 +20,17 @@
|
||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gnu packages cmake)
|
||||
#:use-module (guix licenses)
|
||||
#:use-module ((guix licenses) #:select (bsd-3))
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix utils)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (gnu packages)
|
||||
#:use-module (gnu packages backup)
|
||||
#:use-module (gnu packages compression)
|
||||
#:use-module (gnu packages curl)
|
||||
#:use-module (gnu packages file)
|
||||
#:use-module (srfi srfi-1))
|
||||
#:use-module (gnu packages xml))
|
||||
|
||||
(define-public cmake
|
||||
(package
|
||||
@@ -34,8 +40,7 @@
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
"http://www.cmake.org/files/v"
|
||||
(string-join (take (string-split version #\.) 2)
|
||||
".")
|
||||
(version-major+minor version)
|
||||
"/cmake-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32 "11q21vyrr6c6smyjy81k2k07zmn96ggjia9im9cxwvj0n88bm1fq"))
|
||||
@@ -43,13 +48,12 @@
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
`(#:test-target "test"
|
||||
#:phases (alist-replace
|
||||
'configure
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(let ((out (assoc-ref outputs "out")))
|
||||
;; Replace "/bin/sh" by the right path in... a lot of
|
||||
;; files.
|
||||
(substitute*
|
||||
#:phases (alist-cons-before
|
||||
'configure 'patch-bin-sh
|
||||
(lambda _
|
||||
;; Replace "/bin/sh" by the right path in... a lot of
|
||||
;; files.
|
||||
(substitute*
|
||||
'("Modules/CompilerId/Xcode-3.pbxproj.in"
|
||||
"Modules/CompilerId/Xcode-1.pbxproj.in"
|
||||
"Modules/CompilerId/Xcode-2.pbxproj.in"
|
||||
@@ -62,29 +66,45 @@
|
||||
"Utilities/Release/release_cmake.cmake"
|
||||
"Utilities/cmlibarchive/libarchive/archive_write_set_format_shar.c"
|
||||
"Tests/CMakeLists.txt")
|
||||
(("/bin/sh") (which "sh")))
|
||||
(zero? (system*
|
||||
"./configure"
|
||||
(string-append "--prefix=" out)
|
||||
;; By default, the man pages and other docs land
|
||||
;; in PREFIX/man and PREFIX/doc, but we want them
|
||||
;; in share/{man,doc}. Note that unlike
|
||||
;; autoconf-generated configure scripts, cmake's
|
||||
;; configure prepends "PREFIX/" to what we pass
|
||||
;; to --mandir and --docdir.
|
||||
"--mandir=share/man"
|
||||
,(string-append
|
||||
"--docdir=share/doc/cmake-"
|
||||
(string-join (take (string-split version #\.) 2)
|
||||
"."))))))
|
||||
%standard-phases)))
|
||||
(("/bin/sh") (which "sh"))))
|
||||
(alist-cons-before
|
||||
'configure 'set-paths
|
||||
(lambda _
|
||||
;; Help cmake's bootstrap process to find system libraries
|
||||
(begin
|
||||
(setenv "CMAKE_LIBRARY_PATH" (getenv "LIBRARY_PATH"))
|
||||
(setenv "CMAKE_INCLUDE_PATH" (getenv "CPATH"))))
|
||||
(alist-replace
|
||||
'configure
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(let ((out (assoc-ref outputs "out")))
|
||||
(zero? (system*
|
||||
"./configure"
|
||||
(string-append "--prefix=" out)
|
||||
"--system-libs"
|
||||
;; By default, the man pages and other docs land
|
||||
;; in PREFIX/man and PREFIX/doc, but we want them
|
||||
;; in share/{man,doc}. Note that unlike
|
||||
;; autoconf-generated configure scripts, cmake's
|
||||
;; configure prepends "PREFIX/" to what we pass
|
||||
;; to --mandir and --docdir.
|
||||
"--mandir=share/man"
|
||||
,(string-append
|
||||
"--docdir=share/doc/cmake-"
|
||||
(version-major+minor version))))))
|
||||
%standard-phases)))))
|
||||
(inputs
|
||||
`(("file" ,file)))
|
||||
`(("file" ,file)
|
||||
("curl" ,curl)
|
||||
("zlib" ,zlib)
|
||||
("expat" ,expat)
|
||||
("bzip2" ,bzip2)
|
||||
("libarchive" ,libarchive)))
|
||||
(home-page "http://www.cmake.org/")
|
||||
(synopsis "Cross-platform build system")
|
||||
(description
|
||||
"CMake is a family of tools designed to build, test and package software.
|
||||
CMake is used to control the software compilation process using simple platform
|
||||
and compiler independent configuration files. CMake generates native makefiles
|
||||
and compiler independent configuration files. CMake generates native makefiles
|
||||
and workspaces that can be used in the compiler environment of your choice.")
|
||||
(license bsd-3)))
|
||||
|
||||
@@ -0,0 +1,791 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2014 Andreas Enge <andreas@enge.fr>
|
||||
;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org>
|
||||
;;; Copyright © 2014 Mark H Weaver <mhw@netris.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/>.
|
||||
|
||||
(define-module (gnu packages commencement)
|
||||
#:use-module ((guix licenses)
|
||||
#:select (gpl3+ lgpl2.0+ public-domain))
|
||||
#:use-module (gnu packages bootstrap)
|
||||
#:use-module (gnu packages base)
|
||||
#:use-module (gnu packages bash)
|
||||
#:use-module (gnu packages gcc)
|
||||
#:use-module (gnu packages ed)
|
||||
#:use-module (gnu packages m4)
|
||||
#:use-module (gnu packages file)
|
||||
#:use-module (gnu packages gawk)
|
||||
#:use-module (gnu packages bison)
|
||||
#:use-module (gnu packages guile)
|
||||
#:use-module (gnu packages multiprecision)
|
||||
#:use-module (gnu packages compression)
|
||||
#:use-module (gnu packages perl)
|
||||
#:use-module (gnu packages linux)
|
||||
#:use-module (gnu packages texinfo)
|
||||
#:use-module (gnu packages pkg-config)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (guix build-system trivial)
|
||||
#:use-module (guix utils)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (ice-9 vlist)
|
||||
#:use-module (ice-9 match))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
;;; This is the commencement, this is where things start. Before the
|
||||
;;; commencement, of course, there's the 'bootstrap' module, which provides us
|
||||
;;; with the initial binaries. This module uses those bootstrap binaries to
|
||||
;;; actually build up the whole tool chain that make up the implicit inputs of
|
||||
;;; 'gnu-build-system'.
|
||||
;;;
|
||||
;;; To avoid circular dependencies, this module should not be imported
|
||||
;;; directly from anywhere.
|
||||
;;;
|
||||
;;; Code:
|
||||
|
||||
(define gnu-make-boot0
|
||||
(package-with-bootstrap-guile
|
||||
(package (inherit gnu-make)
|
||||
(name "make-boot0")
|
||||
(location (source-properties->location (current-source-location)))
|
||||
(arguments
|
||||
`(#:guile ,%bootstrap-guile
|
||||
#:implicit-inputs? #f
|
||||
#:tests? #f ; cannot run "make check"
|
||||
,@(substitute-keyword-arguments (package-arguments gnu-make)
|
||||
((#:phases phases)
|
||||
`(alist-replace
|
||||
'build (lambda _
|
||||
(zero? (system* "./build.sh")))
|
||||
(alist-replace
|
||||
'install (lambda* (#:key outputs #:allow-other-keys)
|
||||
(let* ((out (assoc-ref outputs "out"))
|
||||
(bin (string-append out "/bin")))
|
||||
(mkdir-p bin)
|
||||
(copy-file "make"
|
||||
(string-append bin "/make"))))
|
||||
,phases))))))
|
||||
(native-inputs '()) ; no need for 'pkg-config'
|
||||
(inputs %bootstrap-inputs))))
|
||||
|
||||
(define diffutils-boot0
|
||||
(package-with-bootstrap-guile
|
||||
(let ((p (package-with-explicit-inputs diffutils
|
||||
`(("make" ,gnu-make-boot0)
|
||||
,@%bootstrap-inputs)
|
||||
#:guile %bootstrap-guile)))
|
||||
(package (inherit p)
|
||||
(location (source-properties->location (current-source-location)))
|
||||
(arguments `(#:tests? #f ; the test suite needs diffutils
|
||||
,@(package-arguments p)))))))
|
||||
|
||||
(define findutils-boot0
|
||||
(package-with-bootstrap-guile
|
||||
(package-with-explicit-inputs findutils
|
||||
`(("make" ,gnu-make-boot0)
|
||||
("diffutils" ,diffutils-boot0) ; for tests
|
||||
,@%bootstrap-inputs)
|
||||
(current-source-location)
|
||||
#:guile %bootstrap-guile)))
|
||||
|
||||
(define file-boot0
|
||||
(package-with-bootstrap-guile
|
||||
(package-with-explicit-inputs file
|
||||
`(("make" ,gnu-make-boot0)
|
||||
,@%bootstrap-inputs)
|
||||
(current-source-location)
|
||||
#:guile %bootstrap-guile)))
|
||||
|
||||
|
||||
(define %boot0-inputs
|
||||
`(("make" ,gnu-make-boot0)
|
||||
("diffutils" ,diffutils-boot0)
|
||||
("findutils" ,findutils-boot0)
|
||||
("file" ,file-boot0)
|
||||
,@%bootstrap-inputs))
|
||||
|
||||
(define* (nix-system->gnu-triplet
|
||||
#:optional (system (%current-system)) (vendor "unknown"))
|
||||
"Return an a guess of the GNU triplet corresponding to Nix system
|
||||
identifier SYSTEM."
|
||||
(let* ((dash (string-index system #\-))
|
||||
(arch (substring system 0 dash))
|
||||
(os (substring system (+ 1 dash))))
|
||||
(string-append arch
|
||||
"-" vendor "-"
|
||||
(if (string=? os "linux")
|
||||
"linux-gnu"
|
||||
os))))
|
||||
|
||||
(define* (boot-triplet #:optional (system (%current-system)))
|
||||
;; Return the triplet used to create the cross toolchain needed in the
|
||||
;; first bootstrapping stage.
|
||||
(nix-system->gnu-triplet system "guix"))
|
||||
|
||||
;; Following Linux From Scratch, build a cross-toolchain in stage 0. That
|
||||
;; toolchain actually targets the same OS and arch, but it has the advantage
|
||||
;; of being independent of the libc and tools in %BOOTSTRAP-INPUTS, since
|
||||
;; GCC-BOOT0 (below) is built without any reference to the target libc.
|
||||
|
||||
(define binutils-boot0
|
||||
(package-with-bootstrap-guile
|
||||
(package (inherit binutils)
|
||||
(name "binutils-cross-boot0")
|
||||
(arguments
|
||||
`(#:guile ,%bootstrap-guile
|
||||
#:implicit-inputs? #f
|
||||
,@(substitute-keyword-arguments (package-arguments binutils)
|
||||
((#:configure-flags cf)
|
||||
`(cons ,(string-append "--target=" (boot-triplet))
|
||||
,cf)))))
|
||||
(inputs %boot0-inputs))))
|
||||
|
||||
(define gcc-boot0
|
||||
(package-with-bootstrap-guile
|
||||
(package (inherit gcc-4.8)
|
||||
(name "gcc-cross-boot0")
|
||||
(arguments
|
||||
`(#:guile ,%bootstrap-guile
|
||||
#:implicit-inputs? #f
|
||||
#:modules ((guix build gnu-build-system)
|
||||
(guix build utils)
|
||||
(ice-9 regex)
|
||||
(srfi srfi-1)
|
||||
(srfi srfi-26))
|
||||
,@(substitute-keyword-arguments (package-arguments gcc-4.8)
|
||||
((#:configure-flags flags)
|
||||
`(append (list ,(string-append "--target=" (boot-triplet))
|
||||
|
||||
;; No libc yet.
|
||||
"--without-headers"
|
||||
|
||||
;; Disable features not needed at this stage.
|
||||
"--disable-shared"
|
||||
"--enable-languages=c,c++"
|
||||
|
||||
;; libstdc++ cannot be built at this stage
|
||||
;; ("Link tests are not allowed after
|
||||
;; GCC_NO_EXECUTABLES.").
|
||||
"--disable-libstdc++-v3"
|
||||
|
||||
"--disable-threads"
|
||||
"--disable-libmudflap"
|
||||
"--disable-libatomic"
|
||||
"--disable-libsanitizer"
|
||||
"--disable-libitm"
|
||||
"--disable-libgomp"
|
||||
"--disable-libssp"
|
||||
"--disable-libquadmath"
|
||||
"--disable-decimal-float")
|
||||
(remove (cut string-match "--enable-languages.*" <>)
|
||||
,flags)))
|
||||
((#:phases phases)
|
||||
`(alist-cons-after
|
||||
'unpack 'unpack-gmp&co
|
||||
(lambda* (#:key inputs #:allow-other-keys)
|
||||
(let ((gmp (assoc-ref %build-inputs "gmp-source"))
|
||||
(mpfr (assoc-ref %build-inputs "mpfr-source"))
|
||||
(mpc (assoc-ref %build-inputs "mpc-source")))
|
||||
|
||||
;; To reduce the set of pre-built bootstrap inputs, build
|
||||
;; GMP & co. from GCC.
|
||||
(for-each (lambda (source)
|
||||
(or (zero? (system* "tar" "xvf" source))
|
||||
(error "failed to unpack tarball"
|
||||
source)))
|
||||
(list gmp mpfr mpc))
|
||||
|
||||
;; Create symlinks like `gmp' -> `gmp-x.y.z'.
|
||||
,@(map (lambda (lib)
|
||||
;; Drop trailing letters, as gmp-6.0.0a unpacks
|
||||
;; into gmp-6.0.0.
|
||||
`(symlink ,(string-trim-right
|
||||
(package-full-name lib)
|
||||
char-set:letter)
|
||||
,(package-name lib)))
|
||||
(list gmp mpfr mpc))))
|
||||
(alist-cons-after
|
||||
'install 'symlink-libgcc_eh
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(let ((out (assoc-ref outputs "lib")))
|
||||
;; Glibc wants to link against libgcc_eh, so provide
|
||||
;; it.
|
||||
(with-directory-excursion
|
||||
(string-append out "/lib/gcc/"
|
||||
,(boot-triplet)
|
||||
"/" ,(package-version gcc-4.8))
|
||||
(symlink "libgcc.a" "libgcc_eh.a"))))
|
||||
,phases))))))
|
||||
|
||||
(inputs `(("gmp-source" ,(package-source gmp))
|
||||
("mpfr-source" ,(package-source mpfr))
|
||||
("mpc-source" ,(package-source mpc))
|
||||
("binutils-cross" ,binutils-boot0)
|
||||
|
||||
;; Call it differently so that the builder can check whether
|
||||
;; the "libc" input is #f.
|
||||
("libc-native" ,@(assoc-ref %boot0-inputs "libc"))
|
||||
,@(alist-delete "libc" %boot0-inputs)))
|
||||
|
||||
;; No need for Texinfo at this stage.
|
||||
(native-inputs (alist-delete "texinfo"
|
||||
(package-native-inputs gcc-4.8))))))
|
||||
|
||||
(define perl-boot0
|
||||
(package-with-bootstrap-guile
|
||||
(package-with-explicit-inputs perl
|
||||
%boot0-inputs
|
||||
(current-source-location)
|
||||
#:guile %bootstrap-guile)))
|
||||
|
||||
(define (linux-libre-headers-boot0)
|
||||
"Return Linux-Libre header files for the bootstrap environment."
|
||||
;; Note: this is wrapped in a thunk to nicely handle circular dependencies
|
||||
;; between (gnu packages linux) and this module.
|
||||
(package-with-bootstrap-guile
|
||||
(package (inherit linux-libre-headers)
|
||||
(arguments `(#:guile ,%bootstrap-guile
|
||||
#:implicit-inputs? #f
|
||||
,@(package-arguments linux-libre-headers)))
|
||||
(native-inputs
|
||||
`(("perl" ,perl-boot0)
|
||||
,@%boot0-inputs)))))
|
||||
|
||||
(define texinfo-boot0
|
||||
;; Texinfo used to build libc's manual.
|
||||
;; We build without ncurses because it fails to build at this stage, and
|
||||
;; because we don't need the stand-alone Info reader.
|
||||
;; Also, use %BOOT0-INPUTS to avoid building Perl once more.
|
||||
(let ((texinfo (package (inherit texinfo)
|
||||
(inputs (alist-delete "ncurses" (package-inputs texinfo))))))
|
||||
(package-with-bootstrap-guile
|
||||
(package-with-explicit-inputs texinfo %boot0-inputs
|
||||
(current-source-location)
|
||||
#:guile %bootstrap-guile))))
|
||||
|
||||
(define %boot1-inputs
|
||||
;; 2nd stage inputs.
|
||||
`(("gcc" ,gcc-boot0)
|
||||
("binutils-cross" ,binutils-boot0)
|
||||
|
||||
;; Keep "binutils" here because the cross-gcc invokes `as', not the
|
||||
;; cross-`as'.
|
||||
,@%boot0-inputs))
|
||||
|
||||
(define glibc-final-with-bootstrap-bash
|
||||
;; The final libc, "cross-built". If everything went well, the resulting
|
||||
;; store path has no dependencies. Actually, the really-final libc is
|
||||
;; built just below; the only difference is that this one uses the
|
||||
;; bootstrap Bash.
|
||||
(package-with-bootstrap-guile
|
||||
(package (inherit glibc)
|
||||
(name "glibc-intermediate")
|
||||
(arguments
|
||||
`(#:guile ,%bootstrap-guile
|
||||
#:implicit-inputs? #f
|
||||
|
||||
,@(substitute-keyword-arguments (package-arguments glibc)
|
||||
((#:configure-flags flags)
|
||||
`(append (list ,(string-append "--host=" (boot-triplet))
|
||||
,(string-append "--build="
|
||||
(nix-system->gnu-triplet))
|
||||
|
||||
;; Build Sun/ONC RPC support. In particular,
|
||||
;; install rpc/*.h.
|
||||
"--enable-obsolete-rpc")
|
||||
,flags))
|
||||
((#:phases phases)
|
||||
`(alist-cons-before
|
||||
'configure 'pre-configure
|
||||
(lambda* (#:key inputs #:allow-other-keys)
|
||||
;; Don't clobber CPATH with the bootstrap libc.
|
||||
(setenv "NATIVE_CPATH" (getenv "CPATH"))
|
||||
(unsetenv "CPATH")
|
||||
|
||||
;; 'rpcgen' needs native libc headers to be built.
|
||||
(substitute* "sunrpc/Makefile"
|
||||
(("sunrpc-CPPFLAGS =.*" all)
|
||||
(string-append "CPATH = $(NATIVE_CPATH)\n"
|
||||
"export CPATH\n"
|
||||
all "\n"))))
|
||||
,phases)))))
|
||||
(propagated-inputs `(("linux-headers" ,(linux-libre-headers-boot0))))
|
||||
(native-inputs
|
||||
`(("texinfo" ,texinfo-boot0)
|
||||
("perl" ,perl-boot0)))
|
||||
(inputs
|
||||
`(;; The boot inputs. That includes the bootstrap libc. We don't want
|
||||
;; it in $CPATH, hence the 'pre-configure' phase above.
|
||||
,@%boot1-inputs
|
||||
|
||||
;; A native GCC is needed to build `cross-rpcgen'.
|
||||
("native-gcc" ,@(assoc-ref %boot0-inputs "gcc"))
|
||||
|
||||
;; Here, we use the bootstrap Bash, which is not satisfactory
|
||||
;; because we don't want to depend on bootstrap tools.
|
||||
("static-bash" ,@(assoc-ref %boot0-inputs "bash")))))))
|
||||
|
||||
(define (cross-gcc-wrapper gcc binutils glibc bash)
|
||||
"Return a wrapper for the pseudo-cross toolchain GCC/BINUTILS/GLIBC
|
||||
that makes it available under the native tool names."
|
||||
(package (inherit gcc-4.8)
|
||||
(name (string-append (package-name gcc) "-wrapped"))
|
||||
(source #f)
|
||||
(build-system trivial-build-system)
|
||||
(outputs '("out"))
|
||||
(arguments
|
||||
`(#:guile ,%bootstrap-guile
|
||||
#:modules ((guix build utils))
|
||||
#:builder (begin
|
||||
(use-modules (guix build utils))
|
||||
|
||||
(let* ((binutils (assoc-ref %build-inputs "binutils"))
|
||||
(gcc (assoc-ref %build-inputs "gcc"))
|
||||
(libc (assoc-ref %build-inputs "libc"))
|
||||
(bash (assoc-ref %build-inputs "bash"))
|
||||
(out (assoc-ref %outputs "out"))
|
||||
(bindir (string-append out "/bin"))
|
||||
(triplet ,(boot-triplet)))
|
||||
(define (wrap-program program)
|
||||
;; GCC-BOOT0 is a libc-less cross-compiler, so it
|
||||
;; needs to be told where to find the crt files and
|
||||
;; the dynamic linker.
|
||||
(call-with-output-file program
|
||||
(lambda (p)
|
||||
(format p "#!~a/bin/bash
|
||||
exec ~a/bin/~a-~a -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
|
||||
bash
|
||||
gcc triplet program
|
||||
libc libc
|
||||
,(glibc-dynamic-linker))))
|
||||
|
||||
(chmod program #o555))
|
||||
|
||||
(mkdir-p bindir)
|
||||
(with-directory-excursion bindir
|
||||
(for-each (lambda (tool)
|
||||
(symlink (string-append binutils "/bin/"
|
||||
triplet "-" tool)
|
||||
tool))
|
||||
'("ar" "ranlib"))
|
||||
(for-each wrap-program '("gcc" "g++")))))))
|
||||
(native-inputs
|
||||
`(("binutils" ,binutils)
|
||||
("gcc" ,gcc)
|
||||
("libc" ,glibc)
|
||||
("bash" ,bash)))
|
||||
(inputs '())))
|
||||
|
||||
(define bison-boot1
|
||||
;; XXX: This Bison is needed to rebuild Bash's parser, which is modified by
|
||||
;; its CVE patches. Remove it when it's no longer needed.
|
||||
(let* ((m4 (package-with-bootstrap-guile
|
||||
(package-with-explicit-inputs m4 %boot0-inputs
|
||||
(current-source-location)
|
||||
#:guile %bootstrap-guile)))
|
||||
(bison (package (inherit bison)
|
||||
(native-inputs `(("perl" ,perl-boot0)))
|
||||
(propagated-inputs `(("m4" ,m4)))
|
||||
(inputs '()) ;remove Flex...
|
||||
(arguments '(#:tests? #f))))) ;... and thus disable tests
|
||||
(package-with-bootstrap-guile
|
||||
(package-with-explicit-inputs bison %boot0-inputs
|
||||
(current-source-location)
|
||||
#:guile %bootstrap-guile))))
|
||||
|
||||
(define static-bash-for-glibc
|
||||
;; A statically-linked Bash to be embedded in GLIBC-FINAL, for use by
|
||||
;; system(3) & co.
|
||||
(let* ((gcc (cross-gcc-wrapper gcc-boot0 binutils-boot0
|
||||
glibc-final-with-bootstrap-bash
|
||||
(car (assoc-ref %boot1-inputs "bash"))))
|
||||
(bash (package (inherit bash-light)
|
||||
(native-inputs `(("bison" ,bison-boot1)))
|
||||
(arguments
|
||||
`(#:guile ,%bootstrap-guile
|
||||
,@(package-arguments bash-light))))))
|
||||
(package-with-bootstrap-guile
|
||||
(package-with-explicit-inputs (static-package bash)
|
||||
`(("gcc" ,gcc)
|
||||
("libc" ,glibc-final-with-bootstrap-bash)
|
||||
,@(fold alist-delete %boot1-inputs
|
||||
'("gcc" "libc")))
|
||||
(current-source-location)))))
|
||||
|
||||
(define-public glibc-final
|
||||
;; The final glibc, which embeds the statically-linked Bash built above.
|
||||
(package (inherit glibc-final-with-bootstrap-bash)
|
||||
(name "glibc")
|
||||
(inputs `(("static-bash" ,static-bash-for-glibc)
|
||||
,@(alist-delete
|
||||
"static-bash"
|
||||
(package-inputs glibc-final-with-bootstrap-bash))))
|
||||
|
||||
;; The final libc only refers to itself, but the 'debug' output contains
|
||||
;; references to GCC-BOOT0 and to the Linux headers. XXX: Would be great
|
||||
;; if 'allowed-references' were per-output.
|
||||
(arguments
|
||||
`(#:allowed-references
|
||||
,(cons* `(,gcc-boot0 "lib") (linux-libre-headers-boot0)
|
||||
(package-outputs glibc-final-with-bootstrap-bash))
|
||||
|
||||
,@(package-arguments glibc-final-with-bootstrap-bash)))))
|
||||
|
||||
(define gcc-boot0-wrapped
|
||||
;; Make the cross-tools GCC-BOOT0 and BINUTILS-BOOT0 available under the
|
||||
;; non-cross names.
|
||||
(cross-gcc-wrapper gcc-boot0 binutils-boot0 glibc-final
|
||||
(car (assoc-ref %boot1-inputs "bash"))))
|
||||
|
||||
(define %boot2-inputs
|
||||
;; 3rd stage inputs.
|
||||
`(("libc" ,glibc-final)
|
||||
("gcc" ,gcc-boot0-wrapped)
|
||||
,@(fold alist-delete %boot1-inputs '("libc" "gcc"))))
|
||||
|
||||
(define binutils-final
|
||||
(package-with-bootstrap-guile
|
||||
(package (inherit binutils)
|
||||
(arguments
|
||||
`(#:guile ,%bootstrap-guile
|
||||
#:implicit-inputs? #f
|
||||
#:allowed-references ("out" ,glibc-final)
|
||||
,@(package-arguments binutils)))
|
||||
(inputs %boot2-inputs))))
|
||||
|
||||
(define libstdc++
|
||||
;; Intermediate libstdc++ that will allow us to build the final GCC
|
||||
;; (remember that GCC-BOOT0 cannot build libstdc++.)
|
||||
(package-with-bootstrap-guile
|
||||
(package (inherit gcc-4.8)
|
||||
(name "libstdc++")
|
||||
(arguments
|
||||
`(#:guile ,%bootstrap-guile
|
||||
#:implicit-inputs? #f
|
||||
|
||||
#:out-of-source? #t
|
||||
#:phases (alist-cons-before
|
||||
'configure 'chdir
|
||||
(lambda _
|
||||
(chdir "libstdc++-v3"))
|
||||
%standard-phases)
|
||||
#:configure-flags `("--disable-shared"
|
||||
"--disable-libstdcxx-threads"
|
||||
"--disable-libstdcxx-pch"
|
||||
,(string-append "--with-gxx-include-dir="
|
||||
(assoc-ref %outputs "out")
|
||||
"/include"
|
||||
;; "/include/c++/"
|
||||
;; ,(package-version gcc-4.8)
|
||||
))))
|
||||
(outputs '("out"))
|
||||
(inputs %boot2-inputs)
|
||||
(native-inputs '())
|
||||
(propagated-inputs '())
|
||||
(synopsis "GNU C++ standard library (intermediate)"))))
|
||||
|
||||
(define-public gcc-final
|
||||
;; The final GCC.
|
||||
(package (inherit gcc-boot0)
|
||||
(name "gcc")
|
||||
(location (source-properties->location (current-source-location)))
|
||||
(arguments
|
||||
`(#:guile ,%bootstrap-guile
|
||||
#:implicit-inputs? #f
|
||||
|
||||
#:allowed-references ("out" "lib" ,glibc-final)
|
||||
|
||||
;; Build again GMP & co. within GCC's build process, because it's hard
|
||||
;; to do outside (because GCC-BOOT0 is a cross-compiler, and thus
|
||||
;; doesn't honor $LIBRARY_PATH, which breaks `gnu-build-system'.)
|
||||
,@(substitute-keyword-arguments (package-arguments gcc-boot0)
|
||||
((#:configure-flags boot-flags)
|
||||
(let loop ((args (package-arguments gcc-4.8)))
|
||||
(match args
|
||||
((#:configure-flags normal-flags _ ...)
|
||||
normal-flags)
|
||||
((_ rest ...)
|
||||
(loop rest)))))
|
||||
((#:make-flags flags)
|
||||
;; Since $LIBRARY_PATH and $CPATH are not honored, add the
|
||||
;; relevant flags.
|
||||
`(cons (string-append "CPPFLAGS=-I"
|
||||
(assoc-ref %build-inputs "libstdc++")
|
||||
"/include")
|
||||
(map (lambda (flag)
|
||||
(if (string-prefix? "LDFLAGS=" flag)
|
||||
(string-append flag " -L"
|
||||
(assoc-ref %build-inputs "libstdc++")
|
||||
"/lib")
|
||||
flag))
|
||||
,flags)))
|
||||
((#:phases phases)
|
||||
`(alist-delete 'symlink-libgcc_eh ,phases)))))
|
||||
|
||||
;; This time we want Texinfo, so we get the manual.
|
||||
(native-inputs `(("texinfo" ,texinfo-boot0)
|
||||
,@(package-native-inputs gcc-boot0)))
|
||||
|
||||
(inputs `(("gmp-source" ,(package-source gmp))
|
||||
("mpfr-source" ,(package-source mpfr))
|
||||
("mpc-source" ,(package-source mpc))
|
||||
("binutils" ,binutils-final)
|
||||
("libstdc++" ,libstdc++)
|
||||
,@%boot2-inputs))))
|
||||
|
||||
(define ld-wrapper-boot3
|
||||
;; A linker wrapper that uses the bootstrap Guile.
|
||||
(package
|
||||
(name "ld-wrapper-boot3")
|
||||
(version "0")
|
||||
(source #f)
|
||||
(build-system trivial-build-system)
|
||||
(inputs `(("binutils" ,binutils-final)
|
||||
("guile" ,%bootstrap-guile)
|
||||
("bash" ,@(assoc-ref %boot2-inputs "bash"))
|
||||
("wrapper" ,(search-path %load-path
|
||||
"gnu/packages/ld-wrapper.scm"))))
|
||||
(arguments
|
||||
`(#:guile ,%bootstrap-guile
|
||||
#:modules ((guix build utils))
|
||||
#:builder (begin
|
||||
(use-modules (guix build utils)
|
||||
(system base compile))
|
||||
|
||||
(let* ((out (assoc-ref %outputs "out"))
|
||||
(bin (string-append out "/bin"))
|
||||
(ld (string-append bin "/ld"))
|
||||
(go (string-append bin "/ld.go")))
|
||||
|
||||
(setvbuf (current-output-port) _IOLBF)
|
||||
(format #t "building ~s/bin/ld wrapper in ~s~%"
|
||||
(assoc-ref %build-inputs "binutils")
|
||||
out)
|
||||
|
||||
(mkdir-p bin)
|
||||
(copy-file (assoc-ref %build-inputs "wrapper") ld)
|
||||
(substitute* ld
|
||||
(("@GUILE@")
|
||||
(string-append (assoc-ref %build-inputs "guile")
|
||||
"/bin/guile"))
|
||||
(("@BASH@")
|
||||
(string-append (assoc-ref %build-inputs "bash")
|
||||
"/bin/bash"))
|
||||
(("@LD@")
|
||||
(string-append (assoc-ref %build-inputs "binutils")
|
||||
"/bin/ld")))
|
||||
(chmod ld #o555)
|
||||
(compile-file ld #:output-file go)))))
|
||||
(synopsis "The linker wrapper")
|
||||
(description
|
||||
"The linker wrapper (or `ld-wrapper') wraps the linker to add any
|
||||
missing `-rpath' flags, and to detect any misuse of libraries outside of the
|
||||
store.")
|
||||
(home-page #f)
|
||||
(license gpl3+)))
|
||||
|
||||
(define %boot3-inputs
|
||||
;; 4th stage inputs.
|
||||
`(("gcc" ,gcc-final)
|
||||
("ld-wrapper" ,ld-wrapper-boot3)
|
||||
,@(alist-delete "gcc" %boot2-inputs)))
|
||||
|
||||
(define bash-final
|
||||
;; Link with `-static-libgcc' to make sure we don't retain a reference
|
||||
;; to the bootstrap GCC.
|
||||
(package-with-bootstrap-guile
|
||||
(package-with-explicit-inputs (static-libgcc-package bash)
|
||||
%boot3-inputs
|
||||
(current-source-location)
|
||||
#:guile %bootstrap-guile)))
|
||||
|
||||
(define %boot4-inputs
|
||||
;; Now use the final Bash.
|
||||
`(("bash" ,bash-final)
|
||||
,@(alist-delete "bash" %boot3-inputs)))
|
||||
|
||||
(define-public guile-final
|
||||
(package-with-bootstrap-guile
|
||||
(package-with-explicit-inputs guile-2.0/fixed
|
||||
%boot4-inputs
|
||||
(current-source-location)
|
||||
#:guile %bootstrap-guile)))
|
||||
|
||||
(define gnu-make-final
|
||||
;; The final GNU Make, which uses the final Guile.
|
||||
(package-with-bootstrap-guile
|
||||
(package-with-explicit-inputs gnu-make
|
||||
`(("guile" ,guile-final)
|
||||
,@%boot4-inputs)
|
||||
(current-source-location))))
|
||||
|
||||
(define-public ld-wrapper
|
||||
;; The final `ld' wrapper, which uses the final Guile.
|
||||
(package (inherit ld-wrapper-boot3)
|
||||
(name "ld-wrapper")
|
||||
(inputs `(("guile" ,guile-final)
|
||||
("bash" ,bash-final)
|
||||
,@(fold alist-delete (package-inputs ld-wrapper-boot3)
|
||||
'("guile" "bash"))))))
|
||||
|
||||
(define coreutils-final
|
||||
;; The final Coreutils. Treat them specially because some packages, such as
|
||||
;; Findutils, keep a reference to the Coreutils they were built with.
|
||||
(package-with-bootstrap-guile
|
||||
(package-with-explicit-inputs coreutils
|
||||
%boot4-inputs
|
||||
(current-source-location)
|
||||
|
||||
;; Use the final Guile, linked against the
|
||||
;; final libc with working iconv, so that
|
||||
;; 'substitute*' works well when touching
|
||||
;; test files in Gettext.
|
||||
#:guile guile-final)))
|
||||
|
||||
(define grep-final
|
||||
;; The final grep. Gzip holds a reference to it (via zgrep), so it must be
|
||||
;; built before gzip.
|
||||
(package-with-bootstrap-guile
|
||||
(package-with-explicit-inputs grep
|
||||
%boot4-inputs
|
||||
(current-source-location)
|
||||
#:guile guile-final)))
|
||||
|
||||
(define %boot5-inputs
|
||||
;; Now use the final Coreutils.
|
||||
`(("coreutils" ,coreutils-final)
|
||||
("grep" ,grep-final)
|
||||
,@%boot4-inputs))
|
||||
|
||||
(define-public %final-inputs
|
||||
;; Final derivations used as implicit inputs by 'gnu-build-system'. We
|
||||
;; still use 'package-with-bootstrap-guile' so that the bootstrap tools are
|
||||
;; used for origins that have patches, thereby avoiding circular
|
||||
;; dependencies.
|
||||
(let ((finalize (compose package-with-bootstrap-guile
|
||||
(cut package-with-explicit-inputs <> %boot5-inputs
|
||||
(current-source-location)))))
|
||||
`(,@(map (match-lambda
|
||||
((name package)
|
||||
(list name (finalize package))))
|
||||
`(("tar" ,tar)
|
||||
("gzip" ,gzip)
|
||||
("bzip2" ,bzip2)
|
||||
("xz" ,xz)
|
||||
("file" ,file)
|
||||
("diffutils" ,diffutils)
|
||||
("patch" ,patch)
|
||||
("sed" ,sed)
|
||||
("findutils" ,findutils)
|
||||
("gawk" ,gawk)))
|
||||
("grep" ,grep-final)
|
||||
("coreutils" ,coreutils-final)
|
||||
("make" ,gnu-make-final)
|
||||
("bash" ,bash-final)
|
||||
("ld-wrapper" ,ld-wrapper)
|
||||
("binutils" ,binutils-final)
|
||||
("gcc" ,gcc-final)
|
||||
("libc" ,glibc-final))))
|
||||
|
||||
(define-public canonical-package
|
||||
(let ((name->package (fold (lambda (input result)
|
||||
(match input
|
||||
((_ package)
|
||||
(vhash-cons (package-full-name package)
|
||||
package result))))
|
||||
vlist-null
|
||||
`(("guile" ,guile-final)
|
||||
,@%final-inputs))))
|
||||
(lambda (package)
|
||||
"Return the 'canonical' variant of PACKAGE---i.e., if PACKAGE is one of
|
||||
the implicit inputs of 'gnu-build-system', return that one, otherwise return
|
||||
PACKAGE.
|
||||
|
||||
The goal is to avoid duplication in cases like GUILE-FINAL vs. GUILE-2.0,
|
||||
COREUTILS-FINAL vs. COREUTILS, etc."
|
||||
;; XXX: This doesn't handle dependencies of the final inputs, such as
|
||||
;; libunistring, GMP, etc.
|
||||
(match (vhash-assoc (package-full-name package) name->package)
|
||||
((_ . canon)
|
||||
;; In general we want CANON, except if we're cross-compiling: CANON
|
||||
;; uses explicit inputs, so it is "anchored" in the bootstrapped
|
||||
;; process, with dependencies on things that cannot be
|
||||
;; cross-compiled.
|
||||
(if (%current-target-system)
|
||||
package
|
||||
canon))
|
||||
(_ package)))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; GCC toolchain.
|
||||
;;;
|
||||
|
||||
(define (gcc-toolchain gcc)
|
||||
"Return a complete toolchain for GCC."
|
||||
(package
|
||||
(name "gcc-toolchain")
|
||||
(version (package-version gcc))
|
||||
(source #f)
|
||||
(build-system trivial-build-system)
|
||||
(arguments
|
||||
'(#:modules ((guix build union))
|
||||
#:builder (begin
|
||||
(use-modules (ice-9 match)
|
||||
(guix build union))
|
||||
|
||||
(match %build-inputs
|
||||
(((names . directories) ...)
|
||||
(union-build (assoc-ref %outputs "out")
|
||||
directories)))
|
||||
|
||||
(union-build (assoc-ref %outputs "debug")
|
||||
(list (assoc-ref %build-inputs
|
||||
"libc-debug"))))))
|
||||
|
||||
(native-search-paths (package-native-search-paths gcc))
|
||||
(search-paths (package-search-paths gcc))
|
||||
|
||||
(license (package-license gcc))
|
||||
(synopsis "Complete GCC tool chain for C/C++ development")
|
||||
(description
|
||||
"This package provides a complete GCC tool chain for C/C++ development to
|
||||
be installed in user profiles. This includes GCC, as well as libc (headers
|
||||
and binaries, plus debugging symbols in the 'debug' output), and Binutils.")
|
||||
(home-page "http://gcc.gnu.org/")
|
||||
(outputs '("out" "debug"))
|
||||
|
||||
;; The main raison d'être of this "meta-package" is (1) to conveniently
|
||||
;; install everything that we need, and (2) to make sure ld-wrapper comes
|
||||
;; before Binutils' ld in the user's profile.
|
||||
(inputs `(("gcc" ,gcc)
|
||||
("ld-wrapper" ,(car (assoc-ref %final-inputs "ld-wrapper")))
|
||||
("binutils" ,binutils-final)
|
||||
("libc" ,glibc-final)
|
||||
("libc-debug" ,glibc-final "debug")))))
|
||||
|
||||
(define-public gcc-toolchain-4.8
|
||||
(gcc-toolchain gcc-final))
|
||||
|
||||
(define-public gcc-toolchain-4.9
|
||||
(gcc-toolchain gcc-4.9))
|
||||
|
||||
;;; commencement.scm ends here
|
||||
@@ -1,5 +1,5 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
|
||||
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
|
||||
;;;
|
||||
@@ -19,8 +19,7 @@
|
||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gnu packages compression)
|
||||
#:use-module ((guix licenses)
|
||||
#:renamer (symbol-prefix-proc 'license:))
|
||||
#:use-module ((guix licenses) #:prefix license:)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix build-system gnu)
|
||||
@@ -58,12 +57,12 @@
|
||||
(string-append "--prefix=" out)))))
|
||||
%standard-phases)))
|
||||
(home-page "http://zlib.net/")
|
||||
(synopsis "The zlib compression library")
|
||||
(synopsis "Compression library")
|
||||
(description
|
||||
"zlib is designed to be a free, general-purpose, legally unencumbered --
|
||||
that is, not covered by any patents -- lossless data-compression library for
|
||||
use on virtually any computer hardware and operating system. The zlib data
|
||||
format is itself portable across platforms. Unlike the LZW compression method
|
||||
format is itself portable across platforms. Unlike the LZW compression method
|
||||
used in Unix compress(1) and in the GIF image format, the compression method
|
||||
currently used in zlib essentially never expands the data. (LZW can double or
|
||||
triple the file size in extreme cases.) zlib's memory footprint is also
|
||||
@@ -174,7 +173,7 @@ file; as a result, it is often used in conjunction with \"tar\", resulting in
|
||||
,@(if (%current-target-system)
|
||||
'(#:tests? #f)
|
||||
'())))
|
||||
(synopsis "high-quality data compression program")
|
||||
(synopsis "High-quality data compression program")
|
||||
(description
|
||||
"bzip2 is a freely available, patent free (see below), high-quality data
|
||||
compressor. It typically compresses files to within 10% to 15% of the best
|
||||
@@ -197,8 +196,7 @@ decompression.")
|
||||
(base32
|
||||
"1dl35ca8fdss9z2d6y234gxh24ixq904xksizrjmjr5dimwhax6n"))))
|
||||
(build-system gnu-build-system)
|
||||
(synopsis
|
||||
"XZ, general-purpose data compression software, successor of LZMA")
|
||||
(synopsis "General-purpose data compression")
|
||||
(description
|
||||
"XZ Utils is free general-purpose data compression software with high
|
||||
compression ratio. XZ Utils were written for POSIX-like systems, but also
|
||||
@@ -228,7 +226,7 @@ than gzip and 15 % smaller output than bzip2.")
|
||||
(arguments '(#:configure-flags '("--enable-shared")))
|
||||
(home-page "http://www.oberhumer.com/opensource/lzo")
|
||||
(synopsis
|
||||
"A data compresion library suitable for real-time data de-/compression")
|
||||
"Data compresion library suitable for real-time data de-/compression")
|
||||
(description
|
||||
"LZO is a data compression library which is suitable for data
|
||||
de-/compression in real-time. This means it favours speed over
|
||||
@@ -264,14 +262,14 @@ some compression ratio).")
|
||||
(define-public lzip
|
||||
(package
|
||||
(name "lzip")
|
||||
(version "1.15")
|
||||
(version "1.16")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://savannah/lzip/lzip-"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1dh5vmj5apizfawnsm50y7z064yx7cz3313przph16gwd3dgrlvw"))))
|
||||
"0l9724rw1l3hg2ldr3n7ihqich4m9nc6y7l302bvdj4jmxdw530j"))))
|
||||
(build-system gnu-build-system)
|
||||
(home-page "http://www.nongnu.org/lzip/lzip.html")
|
||||
(synopsis "Lossless data compressor based on the LZMA algorithm")
|
||||
|
||||
+35
-44
@@ -1,5 +1,6 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2014 Cyrill Schenkel <cyrill.schenkel@gmail.com>
|
||||
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -20,13 +21,9 @@
|
||||
#:use-module ((guix licenses) #:prefix license:)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix build-system trivial)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (gnu packages)
|
||||
#:use-module (gnu packages gnuzilla)
|
||||
#:use-module (gnu packages base)
|
||||
#:use-module (gnu packages bash)
|
||||
#:use-module (gnu packages compression)
|
||||
#:use-module (ice-9 format))
|
||||
#:use-module (gnu packages gnuzilla))
|
||||
|
||||
(define-public conkeror
|
||||
(package
|
||||
@@ -41,52 +38,46 @@
|
||||
(sha256
|
||||
(base32
|
||||
"1cgjzi7g3g22zcx6bpfnid4i12sb45w6icmxdzjn8d3c0m8qsyp1"))))
|
||||
(build-system trivial-build-system)
|
||||
(inputs `(("icecat" ,icecat)
|
||||
("bash" ,bash)))
|
||||
(native-inputs `(("tar" ,tar)
|
||||
("gzip" ,gzip)))
|
||||
(build-system gnu-build-system)
|
||||
(inputs `(("icecat" ,icecat)))
|
||||
(arguments
|
||||
`(#:modules ((guix build utils))
|
||||
#:builder (begin
|
||||
(use-modules (ice-9 ftw)
|
||||
(guix build utils))
|
||||
(let ((select?
|
||||
(lambda (name)
|
||||
(not (equal? (car (string->list name)) #\.))))
|
||||
(datadir (string-append %output "/share/conkeror"))
|
||||
(launcher "bin/conkeror"))
|
||||
(setenv "PATH" (string-append
|
||||
(assoc-ref %build-inputs "tar") "/bin:"
|
||||
(assoc-ref %build-inputs "gzip") "/bin"))
|
||||
(system* "tar" "xvf" (assoc-ref %build-inputs "source"))
|
||||
(copy-recursively (string-append
|
||||
(getcwd) "/"
|
||||
(car (scandir (getcwd) select?)))
|
||||
datadir)
|
||||
(chdir %output)
|
||||
(mkdir "bin")
|
||||
(call-with-output-file launcher
|
||||
(lambda (p)
|
||||
(format p "#!~a/bin/bash
|
||||
`(#:tests? #f ;no tests
|
||||
#:make-flags '("CC=gcc")
|
||||
#:phases
|
||||
(alist-delete
|
||||
'configure
|
||||
(alist-replace
|
||||
'install
|
||||
(lambda _
|
||||
(begin
|
||||
(use-modules (guix build utils))
|
||||
(let* ((datadir (string-append %output "/share/conkeror"))
|
||||
(bindir (string-append %output "/bin"))
|
||||
(launcher (string-append bindir "/conkeror"))
|
||||
(spawn (string-append bindir "/conkeror-spawn-helper")))
|
||||
(copy-recursively "." datadir)
|
||||
(mkdir-p bindir)
|
||||
(copy-file "conkeror-spawn-helper" spawn)
|
||||
(call-with-output-file launcher
|
||||
(lambda (p)
|
||||
(format p "#!~a/bin/bash
|
||||
exec ~a/bin/icecat --app ~a \"$@\"~%"
|
||||
(assoc-ref %build-inputs "bash")
|
||||
(assoc-ref %build-inputs "icecat")
|
||||
(string-append datadir
|
||||
"/application.ini"))))
|
||||
(chmod launcher #o555)))))
|
||||
(assoc-ref %build-inputs "bash") ;implicit input
|
||||
(assoc-ref %build-inputs "icecat")
|
||||
(string-append datadir
|
||||
"/application.ini"))))
|
||||
(chmod launcher #o555))))
|
||||
%standard-phases))))
|
||||
(synopsis "Keyboard focused web browser with Emacs look and feel")
|
||||
(description "Conkeror is a highly-programmable web browser based on
|
||||
Mozilla XULRunner which is the base of all Mozilla products including
|
||||
Firefox. Conkeror has a sophisticated keyboard system for running commands and
|
||||
interacting with web page content, modelled after Emacs and Lynx. It is
|
||||
Mozilla XULRunner which is the base of all Mozilla products including Firefox.
|
||||
Conkeror has a sophisticated keyboard system for running commands and
|
||||
interacting with web page content, modelled after Emacs and Lynx. It is
|
||||
self-documenting and extensible with JavaScript.
|
||||
|
||||
It comes with builtin support for several Web 2.0 sites like several Google
|
||||
services (Search, Gmail, Maps, Reader, etc.), Del.icio.us, Reddit, Last.fm and
|
||||
YouTube. For easier editing of form fields, it can spawn external editors. For
|
||||
this feature the recommended conkeror-spawn-process-helper package needs to be
|
||||
installed.")
|
||||
YouTube. For easier editing of form fields, it can spawn external editors.")
|
||||
(home-page "http://conkeror.org")
|
||||
;; Conkeror is triple licensed.
|
||||
(license (list license:gpl2
|
||||
|
||||
@@ -75,9 +75,9 @@
|
||||
;; ("inetutils" ,inetutils)
|
||||
("ed" ,ed)))
|
||||
(home-page "http://miller.emu.id.au/pmiller/software/cook")
|
||||
(synopsis "A tool for constructing files")
|
||||
(description "Cook is a tool for constructing files. It is given a set of
|
||||
files to create, and recipes of how to create them. In any non-trivial program
|
||||
(synopsis "Tool for constructing files")
|
||||
(description "Cook is a tool for constructing files. It is given a set of
|
||||
files to create, and recipes of how to create them. In any non-trivial program
|
||||
there will be prerequisites to performing the actions necessary to creating
|
||||
any file, such as include files. Cook provides a mechanism to define these.")
|
||||
any file, such as include files. Cook provides a mechanism to define these.")
|
||||
(license gpl3+)))
|
||||
|
||||
@@ -39,9 +39,9 @@
|
||||
(home-page "https://www.gnu.org/software/cpio/")
|
||||
(synopsis "Manage cpio and tar file archives")
|
||||
(description
|
||||
"GNU cpio copies files into or out of cpio or tar archives. Indeed,
|
||||
"GNU cpio copies files into or out of cpio or tar archives. Indeed,
|
||||
many formats are supported, including legacy formats. The format is
|
||||
determined automatically by the program and is handled appropriately.
|
||||
determined automatically by the program and is handled appropriately.
|
||||
Furthermore, the location of the archive is not important. It can be another
|
||||
file on the drive, a tape, or data on a pipe.")
|
||||
(license gpl3+)))
|
||||
|
||||
+144
-100
@@ -21,6 +21,7 @@
|
||||
#:use-module (gnu packages)
|
||||
#:use-module (gnu packages gcc)
|
||||
#:use-module (gnu packages base)
|
||||
#:use-module (gnu packages commencement)
|
||||
#:use-module (gnu packages linux)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix download)
|
||||
@@ -44,6 +45,12 @@
|
||||
`(cons ,(string-append "--target=" target)
|
||||
,flags))))))
|
||||
|
||||
(define (package-with-patch original patch)
|
||||
"Return package ORIGINAL with PATCH applied."
|
||||
(package (inherit original)
|
||||
(source (origin (inherit (package-source original))
|
||||
(patches (list patch))))))
|
||||
|
||||
(define (cross-binutils target)
|
||||
"Return a cross-Binutils for TARGET."
|
||||
(let ((binutils (package (inherit binutils)
|
||||
@@ -63,7 +70,120 @@
|
||||
;; practice the RUNPATH of target libs only refers to
|
||||
;; target libs, not native libs, so this is safe.
|
||||
`(cons "--with-sysroot=/" ,flags)))))))
|
||||
(cross binutils target)))
|
||||
|
||||
;; For Xtensa, apply Qualcomm's patch.
|
||||
(cross (if (string-prefix? "xtensa-" target)
|
||||
(package-with-patch binutils
|
||||
(search-patch
|
||||
"ath9k-htc-firmware-binutils.patch"))
|
||||
binutils)
|
||||
target)))
|
||||
|
||||
(define (cross-gcc-arguments target libc)
|
||||
"Return build system arguments for a cross-gcc for TARGET, using LIBC (which
|
||||
may be either a libc package or #f.)"
|
||||
;; Set the current target system so that 'glibc-dynamic-linker' returns the
|
||||
;; right name.
|
||||
(parameterize ((%current-target-system target))
|
||||
(substitute-keyword-arguments (package-arguments gcc-4.8)
|
||||
((#:configure-flags flags)
|
||||
`(append (list ,(string-append "--target=" target)
|
||||
,@(gcc-configure-flags-for-triplet target)
|
||||
,@(if libc
|
||||
'()
|
||||
`( ;; Disable features not needed at this stage.
|
||||
"--disable-shared" "--enable-static"
|
||||
|
||||
;; Disable C++ because libstdc++'s configure
|
||||
;; script otherwise fails with "Link tests are not
|
||||
;; allowed after GCC_NO_EXECUTABLES."
|
||||
"--enable-languages=c"
|
||||
|
||||
"--disable-threads" ;libgcc, would need libc
|
||||
"--disable-libatomic"
|
||||
"--disable-libmudflap"
|
||||
"--disable-libgomp"
|
||||
"--disable-libssp"
|
||||
"--disable-libquadmath"
|
||||
"--disable-decimal-float" ;would need libc
|
||||
)))
|
||||
|
||||
,(if libc
|
||||
flags
|
||||
`(remove (cut string-match "--enable-languages.*" <>)
|
||||
,flags))))
|
||||
((#:make-flags flags)
|
||||
(if libc
|
||||
`(let ((libc (assoc-ref %build-inputs "libc")))
|
||||
;; FLAGS_FOR_TARGET are needed for the target libraries to receive
|
||||
;; the -Bxxx for the startfiles.
|
||||
(cons (string-append "FLAGS_FOR_TARGET=-B" libc "/lib")
|
||||
,flags))
|
||||
flags))
|
||||
((#:phases phases)
|
||||
(let ((phases
|
||||
`(alist-cons-after
|
||||
'install 'make-cross-binutils-visible
|
||||
(lambda* (#:key outputs inputs #:allow-other-keys)
|
||||
(let* ((out (assoc-ref outputs "out"))
|
||||
(libexec (string-append out "/libexec/gcc/"
|
||||
,target))
|
||||
(binutils (string-append
|
||||
(assoc-ref inputs "binutils-cross")
|
||||
"/bin/" ,target "-")))
|
||||
(for-each (lambda (file)
|
||||
(symlink (string-append binutils file)
|
||||
(string-append libexec "/"
|
||||
file)))
|
||||
'("as" "ld" "nm"))
|
||||
#t))
|
||||
,phases)))
|
||||
(if libc
|
||||
`(alist-cons-before
|
||||
'configure 'set-cross-path
|
||||
(lambda* (#:key inputs #:allow-other-keys)
|
||||
;; Add the cross Linux headers to CROSS_CPATH, and remove them
|
||||
;; from CPATH.
|
||||
(let ((libc (assoc-ref inputs "libc"))
|
||||
(linux (assoc-ref inputs
|
||||
"libc/linux-headers")))
|
||||
(define (cross? x)
|
||||
;; Return #t if X is a cross-libc or cross Linux.
|
||||
(or (string-prefix? libc x)
|
||||
(string-prefix? linux x)))
|
||||
|
||||
(setenv "CROSS_CPATH"
|
||||
(string-append libc "/include:"
|
||||
linux "/include"))
|
||||
(setenv "CROSS_LIBRARY_PATH"
|
||||
(string-append libc "/lib"))
|
||||
|
||||
(let ((cpath (search-path-as-string->list
|
||||
(getenv "CPATH")))
|
||||
(libpath (search-path-as-string->list
|
||||
(getenv "LIBRARY_PATH"))))
|
||||
(setenv "CPATH"
|
||||
(list->search-path-as-string
|
||||
(remove cross? cpath) ":"))
|
||||
(setenv "LIBRARY_PATH"
|
||||
(list->search-path-as-string
|
||||
(remove cross? libpath) ":"))
|
||||
#t)))
|
||||
,phases)
|
||||
phases)))
|
||||
((#:strip-binaries? _)
|
||||
;; Disable stripping as this can break binaries, with object files of
|
||||
;; libgcc.a showing up as having an unknown architecture. See
|
||||
;; <http://lists.fedoraproject.org/pipermail/arm/2010-August/000663.html>
|
||||
;; for instance.
|
||||
#f))))
|
||||
|
||||
(define (cross-gcc-patches target)
|
||||
"Return GCC patches needed for TARGET."
|
||||
(cond ((string-prefix? "xtensa-" target)
|
||||
;; Patch by Qualcomm needed to build the ath9k-htc firmware.
|
||||
(list (search-patch "ath9k-htc-firmware-gcc.patch")))
|
||||
(else '())))
|
||||
|
||||
(define* (cross-gcc target
|
||||
#:optional (xbinutils (cross-binutils target)) libc)
|
||||
@@ -76,8 +196,8 @@ GCC that does not target a libc; otherwise, target that libc."
|
||||
target))
|
||||
(source (origin (inherit (package-source gcc-4.8))
|
||||
(patches
|
||||
(list (search-patch
|
||||
"gcc-cross-environment-variables.patch")))))
|
||||
(cons (search-patch "gcc-cross-environment-variables.patch")
|
||||
(cross-gcc-patches target)))))
|
||||
|
||||
;; For simplicity, use a single output. Otherwise libgcc_s & co. are not
|
||||
;; found by default, etc.
|
||||
@@ -91,99 +211,7 @@ GCC that does not target a libc; otherwise, target that libc."
|
||||
(srfi srfi-1)
|
||||
(srfi srfi-26))
|
||||
|
||||
,@(substitute-keyword-arguments (package-arguments gcc-4.8)
|
||||
((#:configure-flags flags)
|
||||
`(append (list ,(string-append "--target=" target)
|
||||
,@(gcc-configure-flags-for-triplet target)
|
||||
,@(if libc
|
||||
'()
|
||||
`( ;; Disable features not needed at this stage.
|
||||
"--disable-shared" "--enable-static"
|
||||
|
||||
;; Disable C++ because libstdc++'s
|
||||
;; configure script otherwise fails with
|
||||
;; "Link tests are not allowed after
|
||||
;; GCC_NO_EXECUTABLES."
|
||||
"--enable-languages=c"
|
||||
|
||||
"--disable-threads" ; libgcc, would need libc
|
||||
"--disable-libatomic"
|
||||
"--disable-libmudflap"
|
||||
"--disable-libgomp"
|
||||
"--disable-libssp"
|
||||
"--disable-libquadmath"
|
||||
"--disable-decimal-float" ; would need libc
|
||||
)))
|
||||
|
||||
,(if libc
|
||||
flags
|
||||
`(remove (cut string-match "--enable-languages.*" <>)
|
||||
,flags))))
|
||||
((#:make-flags flags)
|
||||
(if libc
|
||||
`(let ((libc (assoc-ref %build-inputs "libc")))
|
||||
;; FLAGS_FOR_TARGET are needed for the target libraries to
|
||||
;; receive the -Bxxx for the startfiles.
|
||||
(cons (string-append "FLAGS_FOR_TARGET=-B" libc "/lib")
|
||||
,flags))
|
||||
flags))
|
||||
((#:phases phases)
|
||||
(let ((phases
|
||||
`(alist-cons-after
|
||||
'install 'make-cross-binutils-visible
|
||||
(lambda* (#:key outputs inputs #:allow-other-keys)
|
||||
(let* ((out (assoc-ref outputs "out"))
|
||||
(libexec (string-append out "/libexec/gcc/"
|
||||
,target))
|
||||
(binutils (string-append
|
||||
(assoc-ref inputs "binutils-cross")
|
||||
"/bin/" ,target "-")))
|
||||
(for-each (lambda (file)
|
||||
(symlink (string-append binutils file)
|
||||
(string-append libexec "/"
|
||||
file)))
|
||||
'("as" "ld" "nm"))
|
||||
#t))
|
||||
,phases)))
|
||||
(if libc
|
||||
`(alist-cons-before
|
||||
'configure 'set-cross-path
|
||||
(lambda* (#:key inputs #:allow-other-keys)
|
||||
;; Add the cross Linux headers to CROSS_CPATH, and remove
|
||||
;; them from CPATH.
|
||||
(let ((libc (assoc-ref inputs "libc"))
|
||||
(linux (assoc-ref inputs
|
||||
"libc/cross-linux-headers")))
|
||||
(define (cross? x)
|
||||
;; Return #t if X is a cross-libc or cross Linux.
|
||||
(or (string-prefix? libc x)
|
||||
(string-prefix? linux x)))
|
||||
|
||||
(setenv "CROSS_CPATH"
|
||||
(string-append libc "/include:"
|
||||
linux "/include"))
|
||||
(setenv "CROSS_LIBRARY_PATH"
|
||||
(string-append libc "/lib"))
|
||||
|
||||
(let ((cpath (search-path-as-string->list
|
||||
(getenv "CPATH")))
|
||||
(libpath (search-path-as-string->list
|
||||
(getenv "LIBRARY_PATH"))))
|
||||
(setenv "CPATH"
|
||||
(list->search-path-as-string
|
||||
(remove cross? cpath) ":"))
|
||||
(setenv "LIBRARY_PATH"
|
||||
(list->search-path-as-string
|
||||
(remove cross? libpath) ":"))
|
||||
#t)))
|
||||
,phases)
|
||||
phases)))
|
||||
((#:strip-binaries? _)
|
||||
;; Disable stripping as this can break binaries, with object files
|
||||
;; of libgcc.a showing up as having an unknown architecture. See
|
||||
;; <http://lists.fedoraproject.org/pipermail/arm/2010-August/000663.html>
|
||||
;; for instance.
|
||||
#f))))
|
||||
,@(cross-gcc-arguments target libc)))
|
||||
|
||||
(native-inputs
|
||||
`(("binutils-cross" ,xbinutils)
|
||||
@@ -223,7 +251,9 @@ XBINUTILS and the cross tool chain."
|
||||
(name (string-append (package-name linux-libre-headers)
|
||||
"-cross-" target))
|
||||
(arguments
|
||||
(substitute-keyword-arguments (package-arguments linux-libre-headers)
|
||||
(substitute-keyword-arguments
|
||||
`(#:implicit-cross-inputs? #f
|
||||
,@(package-arguments linux-libre-headers))
|
||||
((#:phases phases)
|
||||
`(alist-replace
|
||||
'build
|
||||
@@ -242,7 +272,14 @@ XBINUTILS and the cross tool chain."
|
||||
(name (string-append "glibc-cross-" target))
|
||||
(arguments
|
||||
(substitute-keyword-arguments
|
||||
`(#:strip-binaries? #f ; disable stripping (see above)
|
||||
`(;; Disable stripping (see above.)
|
||||
#:strip-binaries? #f
|
||||
|
||||
;; This package is used as a target input, but it should not have
|
||||
;; the usual cross-compilation inputs since that would include
|
||||
;; itself.
|
||||
#:implicit-cross-inputs? #f
|
||||
|
||||
,@(package-arguments glibc))
|
||||
((#:configure-flags flags)
|
||||
`(cons ,(string-append "--host=" target)
|
||||
@@ -251,13 +288,16 @@ XBINUTILS and the cross tool chain."
|
||||
`(alist-cons-before
|
||||
'configure 'set-cross-linux-headers-path
|
||||
(lambda* (#:key inputs #:allow-other-keys)
|
||||
(let ((linux (assoc-ref inputs "cross-linux-headers")))
|
||||
(let ((linux (assoc-ref inputs "linux-headers")))
|
||||
(setenv "CROSS_CPATH"
|
||||
(string-append linux "/include"))
|
||||
#t))
|
||||
,phases))))
|
||||
|
||||
(propagated-inputs `(("cross-linux-headers" ,xlinux-headers)))
|
||||
;; Shadow the native "linux-headers" because glibc's recipe expect the
|
||||
;; "linux-headers" input to point to the right thing.
|
||||
(propagated-inputs `(("linux-headers" ,xlinux-headers)))
|
||||
|
||||
(native-inputs `(("cross-gcc" ,xgcc)
|
||||
("cross-binutils" ,xbinutils)
|
||||
,@(package-native-inputs glibc)))))
|
||||
@@ -273,6 +313,10 @@ XBINUTILS and the cross tool chain."
|
||||
(cross-binutils triplet)
|
||||
(cross-libc triplet))))
|
||||
|
||||
(define-public xgcc-xtensa
|
||||
;; Bare-bones Xtensa cross-compiler, used to build the Atheros firmware.
|
||||
(cross-gcc "xtensa-elf"))
|
||||
|
||||
;; (define-public xgcc-armel
|
||||
;; (let ((triplet "armel-linux-gnueabi"))
|
||||
;; (cross-gcc triplet
|
||||
|
||||
@@ -26,7 +26,7 @@
|
||||
(define-public libsodium
|
||||
(package
|
||||
(name "libsodium")
|
||||
(version "0.5.0")
|
||||
(version "1.0.0")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
@@ -34,11 +34,11 @@
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1w7rrnsvhhzhywrr3nhlhppv4kqzdszz3dwy8jrsv8lrj5hs181w"))))
|
||||
"19f9vf0shfp4rc4l791r6xjg06z4i8psj1zkjkm3z5b640yzxlff"))))
|
||||
(build-system gnu-build-system)
|
||||
(synopsis "Portable NaCl-based crypto library")
|
||||
(description
|
||||
"libsodium is a new easy-to-use high-speed software library for network
|
||||
"Sodium is a new easy-to-use high-speed software library for network
|
||||
communication, encryption, decryption, signatures, etc.")
|
||||
(license isc)
|
||||
(home-page "https://github.com/jedisct1/libsodium"))) ; No real homepage
|
||||
(home-page "http://libsodium.org")))
|
||||
|
||||
@@ -17,14 +17,12 @@
|
||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gnu packages cryptsetup)
|
||||
#:use-module ((guix licenses)
|
||||
#:renamer (symbol-prefix-proc 'license:))
|
||||
#:use-module ((guix licenses) #:prefix license:)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (gnu packages)
|
||||
#:use-module (gnu packages gnupg)
|
||||
#:use-module (gnu packages lvm)
|
||||
#:use-module (gnu packages popt)
|
||||
#:use-module (gnu packages python)
|
||||
#:use-module (gnu packages linux))
|
||||
@@ -48,12 +46,12 @@
|
||||
("popt" ,popt)))
|
||||
(native-inputs
|
||||
`(("python" ,python-wrapper)))
|
||||
(synopsis "hard disk encryption tool")
|
||||
(synopsis "Hard disk encryption tool")
|
||||
(description
|
||||
"LUKS (Linux Unified Key Setup)/Cryptsetup provides a standard on-disk
|
||||
encryption format, which does not only facilitate compatibility among
|
||||
distributions, but which also provides secure management of multiple user
|
||||
passwords. In contrast to existing solutions, LUKS stores all setup necessary
|
||||
passwords. In contrast to existing solutions, LUKS stores all setup necessary
|
||||
setup information in the partition header, enabling the users to transport
|
||||
or migrate their data seamlessly.")
|
||||
(license license:gpl2)
|
||||
|
||||
+5
-10
@@ -1,5 +1,5 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
|
||||
;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -17,8 +17,7 @@
|
||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gnu packages curl)
|
||||
#:use-module ((guix licenses)
|
||||
#:renamer (symbol-prefix-proc 'license:))
|
||||
#:use-module ((guix licenses) #:prefix license:)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix build-system gnu)
|
||||
@@ -37,18 +36,14 @@
|
||||
(define-public curl
|
||||
(package
|
||||
(name "curl")
|
||||
(version "7.35.0")
|
||||
(version "7.37.1")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "http://curl.haxx.se/download/curl-"
|
||||
version ".tar.lzma"))
|
||||
(sha256
|
||||
(base32
|
||||
"14w5cwh6b1426lxkq6kp6h4vxryr4n7wfrrwhny1r4123q7n8ab9"))
|
||||
(patches
|
||||
;; This patch fixes testcase 172 which uses a hardcoded cookie
|
||||
;; expiration value which is expired as of Feb 1, 2014.
|
||||
(list (search-patch "curl-fix-test172.patch")))))
|
||||
"10yfh4hy8wbkj43la238hg6h8i9wyp1cvvk8kl0giac1020imn5d"))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs `(("gnutls" ,gnutls)
|
||||
("gss" ,gss)
|
||||
@@ -72,7 +67,7 @@
|
||||
(substitute* "tests/runtests.pl"
|
||||
(("/bin/sh") (which "sh"))))
|
||||
%standard-phases)))
|
||||
(synopsis "curl, command line tool for transferring data with URL syntax")
|
||||
(synopsis "Command line tool for transferring data with URL syntax")
|
||||
(description
|
||||
"curl is a command line tool for transferring data with URL syntax,
|
||||
supporting DICT, FILE, FTP, FTPS, Gopher, HTTP, HTTPS, IMAP, IMAPS, LDAP,
|
||||
|
||||
@@ -22,8 +22,7 @@
|
||||
#:use-module (gnu packages gdbm)
|
||||
#:use-module (gnu packages mit-krb5)
|
||||
#:use-module (gnu packages openssl)
|
||||
#:use-module ((guix licenses)
|
||||
#:renamer (symbol-prefix-proc 'license:))
|
||||
#:use-module ((guix licenses) #:prefix license:)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix build-system gnu))
|
||||
@@ -49,11 +48,17 @@
|
||||
(arguments
|
||||
'(#:configure-flags (list (string-append "--with-plugindir="
|
||||
(assoc-ref %outputs "out")
|
||||
"/lib/sasl2"))))
|
||||
(synopsis "Cyrus SASL, an implementation of the Simple Authentication Security Layer framework")
|
||||
"/lib/sasl2"))
|
||||
|
||||
;; The 'plugins' directory has shared source files, such as
|
||||
;; 'plugin_common.c'. When building the shared libraries there, libtool
|
||||
;; ends up doing "ln -s plugin_common.lo plugin_common.o", which can
|
||||
;; fail with EEXIST when building things in parallel.
|
||||
#:parallel-build? #f))
|
||||
(synopsis "Simple Authentication Security Layer implementation")
|
||||
(description
|
||||
"SASL (Simple Authentication Security Layer) is an Internet
|
||||
standards-track method for remote computers to authenticate. The Cyrus SASL
|
||||
standards-track method for remote computers to authenticate. The Cyrus SASL
|
||||
library makes supporting various SASL mechanisms easy for both client and
|
||||
server writers.")
|
||||
(license (license:bsd-style "file://COPYING"
|
||||
|
||||
@@ -0,0 +1,348 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2012, 2014 Andreas Enge <andreas@enge.fr>
|
||||
;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
|
||||
;;; Copyright © 2014 David Thompson <davet@gnu.org>
|
||||
;;; Copyright © 2014 Mark H Weaver <mhw@netris.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/>.
|
||||
|
||||
(define-module (gnu packages databases)
|
||||
#:use-module (gnu packages)
|
||||
#:use-module (gnu packages perl)
|
||||
#:use-module (gnu packages linux)
|
||||
#:use-module (gnu packages openssl)
|
||||
#:use-module (gnu packages compression)
|
||||
#:use-module (gnu packages ncurses)
|
||||
#:use-module (gnu packages readline)
|
||||
#:use-module (gnu packages emacs)
|
||||
#:use-module (gnu packages check)
|
||||
#:use-module (gnu packages algebra)
|
||||
#:use-module (gnu packages curl)
|
||||
#:use-module (gnu packages gnupg)
|
||||
#:use-module (gnu packages python)
|
||||
#:use-module ((guix licenses)
|
||||
#:select (gpl2 gpl3+ lgpl2.1+ lgpl3+ x11-style bsd-style
|
||||
public-domain))
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (guix build-system perl)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (ice-9 match))
|
||||
|
||||
(define-public bdb
|
||||
(package
|
||||
(name "bdb")
|
||||
(version "5.3.21")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "http://download.oracle.com/berkeley-db/db-" version
|
||||
".tar.gz"))
|
||||
(sha256 (base32
|
||||
"1f2g2612lf8djbwbwhxsvmffmf9d7693kh2l20195pqp0f9jmnfx"))))
|
||||
(build-system gnu-build-system)
|
||||
(outputs '("out" ; programs, libraries, headers
|
||||
"doc")) ; 94 MiB of HTML docs
|
||||
(arguments
|
||||
'(#:tests? #f ; no check target available
|
||||
#:phases
|
||||
(alist-replace
|
||||
'configure
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(let ((out (assoc-ref outputs "out"))
|
||||
(doc (assoc-ref outputs "doc")))
|
||||
;; '--docdir' is not honored, so we need to patch.
|
||||
(substitute* "dist/Makefile.in"
|
||||
(("docdir[[:blank:]]*=.*")
|
||||
(string-append "docdir = " doc "/share/doc/bdb")))
|
||||
|
||||
(zero?
|
||||
(system* "./dist/configure"
|
||||
(string-append "--prefix=" out)
|
||||
(string-append "CONFIG_SHELL=" (which "bash"))
|
||||
(string-append "SHELL=" (which "bash"))
|
||||
|
||||
;; The compatibility mode is needed by some packages,
|
||||
;; notably iproute2.
|
||||
"--enable-compat185"))))
|
||||
%standard-phases)))
|
||||
(synopsis "Berkeley database")
|
||||
(description
|
||||
"Berkeley DB is an embeddable database allowing developers the choice of
|
||||
SQL, Key/Value, XML/XQuery or Java Object storage for their data model.")
|
||||
(license (bsd-style "file://LICENSE"
|
||||
"See LICENSE in the distribution."))
|
||||
(home-page
|
||||
"http://www.oracle.com/us/products/database/berkeley-db/overview/index.html")))
|
||||
|
||||
(define-public mysql
|
||||
(package
|
||||
(name "mysql")
|
||||
(version "5.1.73")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
"http://dev.mysql.com/get/Downloads/MySQL-5.1/mysql-"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1dfwi4ck0vq6sdci6gz0031s7zz5lc3pddqlgm0292s00l9y5sq5"))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs
|
||||
`(("procps" ,procps)
|
||||
("openssl" ,openssl)
|
||||
("perl" ,perl)
|
||||
("zlib" ,zlib)
|
||||
("ncurses" ,ncurses)))
|
||||
(arguments
|
||||
'(#:modules ((guix build gnu-build-system)
|
||||
(guix build utils)
|
||||
(ice-9 ftw)) ; for "rm -rf"
|
||||
#:phases (alist-cons-after
|
||||
'install 'clean-up
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
;; Remove the 112 MiB of tests that get installed.
|
||||
(let ((out (assoc-ref outputs "out")))
|
||||
(define (rm-rf dir)
|
||||
(file-system-fold (const #t) ; enter?
|
||||
(lambda (file stat result) ; leaf
|
||||
(delete-file file))
|
||||
(const #t) ; down
|
||||
(lambda (dir stat result) ; up
|
||||
(rmdir dir))
|
||||
(const #t)
|
||||
(lambda (file stat errno result)
|
||||
(format (current-error-port)
|
||||
"error: ~a: ~a~%"
|
||||
file (strerror errno)))
|
||||
#t
|
||||
(string-append out "/" dir)))
|
||||
(rm-rf "mysql-test")
|
||||
(rm-rf "sql-bench")
|
||||
|
||||
;; Compress the 14 MiB Info file.
|
||||
(zero?
|
||||
(system* "gzip" "--best"
|
||||
(string-append out "/share/info/mysql.info")))))
|
||||
%standard-phases)))
|
||||
(home-page "http://www.mysql.com/")
|
||||
(synopsis "Fast, easy to use, and popular database")
|
||||
(description
|
||||
"MySQL is a fast, reliable, and easy to use relational database
|
||||
management system that supports the standardized Structured Query
|
||||
Language.")
|
||||
(license gpl2)))
|
||||
|
||||
(define-public postgresql
|
||||
(package
|
||||
(name "postgresql")
|
||||
(version "9.3.5")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "http://ftp.postgresql.org/pub/source/v"
|
||||
version "/postgresql-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"08kga00izykgvnx7hn995wc4zjqslspapaa8z63045p1ya14mr4g"))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs
|
||||
`(("readline" ,readline)
|
||||
("zlib" ,zlib)))
|
||||
(home-page "http://www.postgresql.org/")
|
||||
(synopsis "Powerful object-relational database system")
|
||||
(description
|
||||
"PostgreSQL is a powerful object-relational database system. It is fully
|
||||
ACID compliant, has full support for foreign keys, joins, views, triggers, and
|
||||
stored procedures (in multiple languages). It includes most SQL:2008 data
|
||||
types, including INTEGER, NUMERIC, BOOLEAN, CHAR, VARCHAR, DATE, INTERVAL, and
|
||||
TIMESTAMP. It also supports storage of binary large objects, including
|
||||
pictures, sounds, or video.")
|
||||
(license (x11-style "file://COPYRIGHT"))))
|
||||
|
||||
(define-public recutils
|
||||
(package
|
||||
(name "recutils")
|
||||
(version "1.7")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnu/recutils/recutils-"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0cdwa4094x3yx7vn98xykvnlp9rngvd58d19vs3vh5hrvggccg93"))))
|
||||
(build-system gnu-build-system)
|
||||
|
||||
;; Running tests in parallel leads to test failures and crashes in
|
||||
;; torture/utils.
|
||||
(arguments '(#:parallel-tests? #f))
|
||||
|
||||
(native-inputs `(("emacs" ,emacs)
|
||||
("bc" ,bc)))
|
||||
|
||||
;; TODO: Add more optional inputs.
|
||||
;; FIXME: Our Bash doesn't have development headers (need for the 'readrec'
|
||||
;; built-in command), but it's not clear how to get them installed.
|
||||
;; See <https://lists.gnu.org/archive/html/bug-bash/2014-03/msg00125.html>.
|
||||
(inputs `(("curl" ,curl)
|
||||
("libgcrypt" ,libgcrypt)
|
||||
("check" ,check)))
|
||||
(synopsis "Manipulate plain text files as databases")
|
||||
(description
|
||||
"GNU Recutils is a set of tools and libraries for creating and
|
||||
manipulating text-based, human-editable databases. Despite being text-based,
|
||||
databases created with Recutils carry all of the expected features such as
|
||||
unique fields, primary keys, time stamps and more. Many different field
|
||||
types are supported, as is encryption.")
|
||||
(license gpl3+)
|
||||
(home-page "http://www.gnu.org/software/recutils/")))
|
||||
|
||||
(define-public sqlite
|
||||
(package
|
||||
(name "sqlite")
|
||||
(version "3.8.4.3")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
;; TODO: Download from sqlite.org once this bug :
|
||||
;; http://lists.gnu.org/archive/html/bug-guile/2013-01/msg00027.html
|
||||
;; has been fixed.
|
||||
(uri (let ((numeric-version
|
||||
(match (string-split version #\.)
|
||||
((first-digit other-digits ...)
|
||||
(string-append first-digit
|
||||
(string-pad-right
|
||||
(string-concatenate
|
||||
(map (cut string-pad <> 2 #\0)
|
||||
other-digits))
|
||||
6 #\0))))))
|
||||
(string-append
|
||||
"mirror://sourceforge/sqlite.mirror/SQLite%20" version
|
||||
"/sqlite-autoconf-" numeric-version ".tar.gz")))
|
||||
(sha256
|
||||
(base32
|
||||
"0rcdsk5sz34w8vy0g5yhfms4saiq81i872jxx5m5sjij7bi9bsg0"))
|
||||
(patches
|
||||
(list (search-patch "sqlite-large-page-size-fix.patch")))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs
|
||||
`(("readline" ,readline)))
|
||||
(home-page "http://www.sqlite.org/")
|
||||
(synopsis "The SQLite database management system")
|
||||
(description
|
||||
"SQLite is a software library that implements a self-contained, serverless,
|
||||
zero-configuration, transactional SQL database engine. SQLite is the most
|
||||
widely deployed SQL database engine in the world. The source code for SQLite
|
||||
is in the public domain.")
|
||||
(license public-domain)))
|
||||
|
||||
(define-public tdb
|
||||
(package
|
||||
(name "tdb")
|
||||
(version "1.3.0")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "http://samba.org/ftp/tdb/tdb-"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"085sd2kii72fr0c4pdc7c7m0xk34nc66wnjp21c83dss826y9gh4"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
'(#:phases (alist-replace
|
||||
'configure
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(let ((out (assoc-ref outputs "out")))
|
||||
;; The 'configure' script is a wrapper for Waf and
|
||||
;; doesn't recognize things like '--enable-fast-install'.
|
||||
(zero? (system* "./configure"
|
||||
(string-append "--prefix=" out)))))
|
||||
%standard-phases)))
|
||||
(native-inputs
|
||||
`(;; TODO: Build the documentation.
|
||||
;; ("docbook-xsl" ,docbook-xsl)
|
||||
;; ("libxml2" ,libxml2)
|
||||
;; ("libxslt" ,libxslt)
|
||||
("python" ,python-2))) ;for the Waf build system
|
||||
(home-page "http://tdb.samba.org/")
|
||||
(synopsis "Trivial database")
|
||||
(description
|
||||
"TDB is a Trivial Database. In concept, it is very much like GDBM,
|
||||
and BSD's DB except that it allows multiple simultaneous writers and uses
|
||||
locking internally to keep writers from trampling on each other. TDB is also
|
||||
extremely small.")
|
||||
(license lgpl3+)))
|
||||
|
||||
(define-public perl-dbi
|
||||
(package
|
||||
(name "perl-dbi")
|
||||
(version "1.631")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
"mirror://cpan/authors/id/T/TI/TIMB/DBI-"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"04fmrnchhwi7jx4niaiv93vmi343hdm3xj04w9zr2m9hhqh782np"))))
|
||||
(build-system perl-build-system)
|
||||
(synopsis "Database independent interface for Perl")
|
||||
(description "This package provides an database interface for Perl.")
|
||||
(home-page "http://search.cpan.org/~timb/DBI-1.631/DBI.pm")
|
||||
(license (package-license perl))))
|
||||
|
||||
(define-public perl-dbd-sqlite
|
||||
(package
|
||||
(name "perl-dbd-sqlite")
|
||||
(version "1.42")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
"mirror://cpan/authors/id/I/IS/ISHIGAKI/DBD-SQLite-"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"14x9cjsc8dz8ad1nad0bqiq9cbk1rjfb8h5y0rpk3pdl38y6afxb"))))
|
||||
(build-system perl-build-system)
|
||||
(inputs `(("sqlite" ,sqlite)))
|
||||
(propagated-inputs `(("perl-dbi" ,perl-dbi)))
|
||||
(synopsis "SQlite interface for Perl")
|
||||
(description "DBD::SQLite is a Perl DBI driver for SQLite, that includes
|
||||
the entire thing in the distribution. So in order to get a fast transaction
|
||||
capable RDBMS working for your Perl project you simply have to install this
|
||||
module, and nothing else.")
|
||||
(license (package-license perl))
|
||||
(home-page "http://search.cpan.org/~ishigaki/DBD-SQLite/lib/DBD/SQLite.pm")))
|
||||
|
||||
|
||||
(define-public unixodbc
|
||||
(package
|
||||
(name "unixodbc")
|
||||
(version "2.3.2")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri
|
||||
(string-append
|
||||
"ftp://ftp.unixodbc.org/pub/unixODBC/unixODBC-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32 "16jw5fq7wgfky6ak1h2j2pqx99jivsdl4q8aq6immpr55xs5jd4w"))))
|
||||
(build-system gnu-build-system)
|
||||
(synopsis "Data source abstraction library")
|
||||
(description "Unixodbc is a library providing an API with which to access
|
||||
data sources. Data sources include SQL Servers and any software with an ODBC
|
||||
Driver.")
|
||||
(license lgpl2.1+)
|
||||
;; COPYING contains copy of lgpl2.1 - but copyright notices just say "LGPL"
|
||||
(home-page "http://www.unixodbc.org")))
|
||||
@@ -27,7 +27,7 @@
|
||||
(define-public datamash
|
||||
(package
|
||||
(name "datamash")
|
||||
(version "1.0.5")
|
||||
(version "1.0.6")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
@@ -35,7 +35,7 @@
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0f4rbbhl18fb851npza9cl8biynzr081f37ih2xsbvjlyrxhnz6b"))))
|
||||
"0621a1xyf8gvcks0vb26g72dm4zh1s6y3a4cc5nnnl5m8mfc4m01"))))
|
||||
(native-inputs
|
||||
`(("which" ,which) ;for tests
|
||||
("perl" ,perl))) ;for help2man
|
||||
@@ -45,4 +45,4 @@
|
||||
(description
|
||||
"Perform basic numeric, textual and statistical operations on plain text
|
||||
files. Designed to work within standard pipelines without additional code.")
|
||||
(license gpl3)))
|
||||
(license gpl3+)))
|
||||
|
||||
+2
-3
@@ -23,12 +23,11 @@
|
||||
#:use-module (gnu packages gnutls)
|
||||
#:use-module (gnu packages ncurses)
|
||||
#:use-module (gnu packages pkg-config)
|
||||
#:use-module (gnu packages sqlite)
|
||||
#:use-module (gnu packages databases)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module ((guix licenses)
|
||||
#:renamer (symbol-prefix-proc 'license:)))
|
||||
#:use-module ((guix licenses) #:prefix license:))
|
||||
|
||||
(define-public ncdc
|
||||
(package
|
||||
|
||||
@@ -1,5 +1,6 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -19,11 +20,17 @@
|
||||
(define-module (gnu packages docbook)
|
||||
#:use-module (gnu packages)
|
||||
#:use-module (gnu packages compression)
|
||||
#:use-module (gnu packages imagemagick)
|
||||
#:use-module (gnu packages inkscape)
|
||||
#:use-module (gnu packages texlive)
|
||||
#:use-module (gnu packages python)
|
||||
#:use-module (gnu packages base)
|
||||
#:use-module (gnu packages xml)
|
||||
#:use-module (guix licenses)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix build-system trivial)
|
||||
#:use-module (guix build-system python)
|
||||
#:autoload (gnu packages zip) (unzip))
|
||||
|
||||
(define-public docbook-xml
|
||||
@@ -87,6 +94,17 @@ by no means limited to these applications.) This package provides XML DTDs.")
|
||||
(base32
|
||||
"0r1l2if1z4wm2v664sqdizm4gak6db1kx9y50jq89m3gxaa8l1i3"))))))
|
||||
|
||||
(define-public docbook-xml-4.2
|
||||
(package (inherit docbook-xml)
|
||||
(version "4.2")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "http://www.docbook.org/xml/" version
|
||||
"/docbook-xml-" version ".zip"))
|
||||
(sha256
|
||||
(base32
|
||||
"18hgwvmywh6a5jh38szjmg3hg2r4v5lb6r3ydc3rd8cp9wg61i5c"))))))
|
||||
|
||||
(define-public docbook-xsl
|
||||
(package
|
||||
(name "docbook-xsl")
|
||||
@@ -126,3 +144,50 @@ by no means limited to these applications.) This package provides XML DTDs.")
|
||||
(description
|
||||
"This package provides XSL style sheets for DocBook.")
|
||||
(license (x11-style "" "See 'COPYING' file."))))
|
||||
|
||||
(define-public dblatex
|
||||
(package
|
||||
(name "dblatex")
|
||||
(version "0.3.5")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://sourceforge/dblatex/dblatex-"
|
||||
version ".tar.bz2"))
|
||||
(sha256
|
||||
(base32
|
||||
"0h3472n33pabrn8qwggsahkrjx8lybpwlc3zprby3w3w3x5i830f"))))
|
||||
(build-system python-build-system)
|
||||
;; TODO: Add xfig/transfig for fig2dev utility
|
||||
(inputs
|
||||
`(("python-setuptools" ,python-setuptools)
|
||||
("texlive" ,texlive)
|
||||
("imagemagick" ,imagemagick) ;for convert
|
||||
("inkscape" ,inkscape) ;for svg conversion
|
||||
("docbook" ,docbook-xml)
|
||||
("libxslt" ,libxslt))) ;for xsltproc
|
||||
(arguments
|
||||
`(#:python ,python-2 ;'print' syntax
|
||||
#:tests? #f ;no 'test' command
|
||||
#:phases
|
||||
(alist-cons-after
|
||||
'wrap 'set-path
|
||||
(lambda* (#:key inputs outputs #:allow-other-keys)
|
||||
(let ((out (assoc-ref outputs "out")))
|
||||
;; dblatex executes helper programs at runtime.
|
||||
(wrap-program (string-append out "/bin/dblatex")
|
||||
`("PATH" ":" prefix
|
||||
,(map (lambda (input)
|
||||
(string-append (assoc-ref inputs input)
|
||||
"/bin"))
|
||||
'("libxslt" "texlive"
|
||||
"imagemagick" "inkscape"))))))
|
||||
%standard-phases)))
|
||||
(home-page "http://dblatex.sourceforge.net")
|
||||
(synopsis "DocBook to LaTeX Publishing")
|
||||
(description
|
||||
"DocBook to LaTeX Publishing transforms your SGML/XML DocBook documents
|
||||
to DVI, PostScript or PDF by translating them in pure LaTeX as a first
|
||||
process. MathML 2.0 markups are supported too. It started as a clone of
|
||||
DB2LaTeX.")
|
||||
;; lib/contrib/which is under an X11 license
|
||||
(license gpl2+)))
|
||||
|
||||
@@ -65,7 +65,7 @@
|
||||
"--prefix" out))))
|
||||
%standard-phases)))
|
||||
(home-page "http://www.stack.nl/~dimitri/doxygen/")
|
||||
(synopsis "tool for generating documentation from annotated sources")
|
||||
(synopsis "Generate documentation from annotated sources")
|
||||
(description "Doxygen is the de facto standard tool for generating
|
||||
documentation from annotated C++ sources, but it also supports other popular
|
||||
programming languages such as C, Objective-C, C#, PHP, Java, Python,
|
||||
|
||||
+12
-12
@@ -57,27 +57,27 @@
|
||||
(home-page "http://dwm.suckless.org/")
|
||||
(synopsis "Dynamic window manager")
|
||||
(description
|
||||
"dwm is a dynamic window manager for X. It manages windows in tiled,
|
||||
monocle and floating layouts. All of the layouts can be applied dynamically,
|
||||
"dwm is a dynamic window manager for X. It manages windows in tiled,
|
||||
monocle and floating layouts. All of the layouts can be applied dynamically,
|
||||
optimising the environment for the application in use and the task performed.
|
||||
|
||||
In tiled layout windows are managed in a master and stacking area. The master
|
||||
In tiled layout windows are managed in a master and stacking area. The master
|
||||
area contains the window which currently needs most attention, whereas the
|
||||
stacking area contains all other windows. In monocle layout all windows are
|
||||
maximised to the screen size. In floating layout windows can be resized and
|
||||
moved freely. Dialog windows are always managed floating, regardless of the
|
||||
stacking area contains all other windows. In monocle layout all windows are
|
||||
maximised to the screen size. In floating layout windows can be resized and
|
||||
moved freely. Dialog windows are always managed floating, regardless of the
|
||||
layout applied.
|
||||
|
||||
Windows are grouped by tags. Each window can be tagged with one or multiple
|
||||
tags. Selecting certain tags displays all windows with these tags.
|
||||
Windows are grouped by tags. Each window can be tagged with one or multiple
|
||||
tags. Selecting certain tags displays all windows with these tags.
|
||||
|
||||
Each screen contains a small status bar which displays all available tags, the
|
||||
layout, the number of visible windows, the title of the focused window, and the
|
||||
text read from the root window name property, if the screen is focused. A
|
||||
text read from the root window name property, if the screen is focused. A
|
||||
floating window is indicated with an empty square and a maximised floating
|
||||
window is indicated with a filled square before the windows title. The selected
|
||||
tags are indicated with a different color. The tags of the focused window are
|
||||
indicated with a filled square in the top left corner. The tags which are
|
||||
window is indicated with a filled square before the windows title. The selected
|
||||
tags are indicated with a different color. The tags of the focused window are
|
||||
indicated with a filled square in the top left corner. The tags which are
|
||||
applied to one or more windows are indicated with an empty square in the top
|
||||
left corner.
|
||||
|
||||
|
||||
+1
-1
@@ -50,6 +50,6 @@
|
||||
"Ed is a line-oriented text editor: rather than offering an overview of
|
||||
a document, ed performs editing one line at a time. It can be executed both
|
||||
interactively and via shell scripts. Its method of command input allows
|
||||
complex tasks to be performed in an automated way. GNU ed offers several
|
||||
complex tasks to be performed in an automated way. GNU ed offers several
|
||||
extensions over the standard utility.")
|
||||
(license gpl3+)))
|
||||
|
||||
@@ -80,8 +80,8 @@ addr2line, and more.")
|
||||
(string-append "--prefix=" out)))))
|
||||
%standard-phases)))
|
||||
(home-page "http://www.mr511.de/software/english.html")
|
||||
(synopsis "An ELF object file access library")
|
||||
(description "libelf is a C library to access ELF object files.")
|
||||
(synopsis "ELF object file access library")
|
||||
(description "Libelf is a C library to access ELF object files.")
|
||||
(license lgpl2.0+)))
|
||||
|
||||
(define-public patchelf
|
||||
|
||||
+242
-15
@@ -1,5 +1,7 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2014 Taylan Ulrich Bayirli/Kammer <taylanbayirli@gmail.com>
|
||||
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -21,6 +23,7 @@
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (guix build-system trivial)
|
||||
#:use-module (gnu packages)
|
||||
#:use-module (gnu packages gtk)
|
||||
#:use-module (gnu packages ncurses)
|
||||
@@ -31,31 +34,33 @@
|
||||
#:use-module (gnu packages xorg)
|
||||
#:use-module (gnu packages lesstif)
|
||||
#:use-module (gnu packages image)
|
||||
#:use-module (gnu packages giflib)
|
||||
#:use-module (gnu packages linux)
|
||||
#:use-module ((gnu packages compression)
|
||||
#:renamer (symbol-prefix-proc 'compression:))
|
||||
#:use-module (gnu packages version-control)
|
||||
#:use-module (gnu packages imagemagick)
|
||||
#:use-module (gnu packages w3m)
|
||||
#:use-module (gnu packages wget)
|
||||
#:use-module (gnu packages autotools)
|
||||
#:use-module ((gnu packages compression) #:prefix compression:)
|
||||
#:use-module (gnu packages xml)
|
||||
#:use-module (gnu packages glib))
|
||||
#:use-module (gnu packages glib)
|
||||
#:use-module (gnu packages acl)
|
||||
#:use-module (guix utils)
|
||||
#:use-module (srfi srfi-1))
|
||||
|
||||
(define-public emacs
|
||||
(package
|
||||
(name "emacs")
|
||||
(version "24.3")
|
||||
(version "24.4")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnu/emacs/emacs-"
|
||||
version ".tar.xz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1385qzs3bsa52s5rcncbrkxlydkw0ajzrvfxgv8rws5fx512kakh"))
|
||||
(patches (list (search-patch "emacs-configure-sh.patch")))))
|
||||
"1zflm6ac34s6v166p58ilxrxbxjm0q2wfc25f8y0mjml1lbr3qs7"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
'(#:configure-flags
|
||||
(list (string-append "--with-crt-dir=" (assoc-ref %build-inputs "libc")
|
||||
"/lib"))
|
||||
#:phases (alist-cons-before
|
||||
'(#:phases (alist-cons-before
|
||||
'configure 'fix-/bin/pwd
|
||||
(lambda _
|
||||
;; Use `pwd', not `/bin/pwd'.
|
||||
@@ -69,11 +74,12 @@
|
||||
|
||||
;; TODO: Add the optional dependencies.
|
||||
("xlibs" ,libx11)
|
||||
("gtk+" ,gtk+-2)
|
||||
("gtk+" ,gtk+)
|
||||
("libXft" ,libxft)
|
||||
("libtiff" ,libtiff)
|
||||
("giflib" ,giflib)
|
||||
("libjpeg" ,libjpeg-8)
|
||||
("acl" ,acl)
|
||||
|
||||
;; When looking for libpng `configure' links with `-lpng -lz', so we
|
||||
;; must also provide zlib as an input.
|
||||
@@ -102,6 +108,17 @@ large Lisp programs. It has full Unicode support for nearly all human
|
||||
languages.")
|
||||
(license gpl3+)))
|
||||
|
||||
(define-public emacs-no-x-toolkit
|
||||
(package (inherit emacs)
|
||||
(location (source-properties->location (current-source-location)))
|
||||
(name "emacs-no-x-toolkit")
|
||||
(synopsis "The extensible, customizable, self-documenting text
|
||||
editor (without an X toolkit)" )
|
||||
(inputs (append `(("inotify-tools" ,inotify-tools))
|
||||
(alist-delete "gtk+" (package-inputs emacs))))
|
||||
(arguments (append '(#:configure-flags '("--with-x-toolkit=no"))
|
||||
(package-arguments emacs)))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Emacs hacking.
|
||||
@@ -110,13 +127,13 @@ languages.")
|
||||
(define-public geiser
|
||||
(package
|
||||
(name "geiser")
|
||||
(version "0.4")
|
||||
(version "0.6")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://savannah/geiser/" version
|
||||
"/geiser-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32 "0ds7zk9b1839l9fsqfsgrby6manvy1cf5bjniiqhxl55h0cr6ijp"))))
|
||||
(base32 "1mrk0bzqcpfhsw6635qznn47nzfy9ps7wrhkpymswdfpw5mdsry5"))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs `(("guile" ,guile-2.0)
|
||||
("emacs" ,emacs)))
|
||||
@@ -138,3 +155,213 @@ of the stage in Geiser. A bundle of Elisp shims orchestrates the dialog
|
||||
between the Scheme interpreter, Emacs and, ultimately, the schemer,
|
||||
giving her access to live metadata.")
|
||||
(license bsd-3)))
|
||||
|
||||
(define-public paredit
|
||||
(package
|
||||
(name "paredit")
|
||||
(version "23")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "http://mumble.net/~campbell/emacs/paredit-"
|
||||
version ".el"))
|
||||
(sha256
|
||||
(base32 "1np882jzvxckljx3cjz4absyzmc5hw65cs21sjmbic82163m9lf8"))))
|
||||
(build-system trivial-build-system)
|
||||
(inputs `(("emacs" ,emacs)))
|
||||
(arguments
|
||||
`(#:modules ((guix build utils)
|
||||
(guix build emacs-utils))
|
||||
#:builder
|
||||
(begin
|
||||
(use-modules (guix build utils))
|
||||
(use-modules (guix build emacs-utils))
|
||||
|
||||
(let* ((emacs (string-append (assoc-ref %build-inputs "emacs")
|
||||
"/bin/emacs"))
|
||||
(source (assoc-ref %build-inputs "source"))
|
||||
(lisp-dir (string-append %output
|
||||
"/share/emacs/site-lisp"))
|
||||
(target (string-append lisp-dir "/paredit.el")))
|
||||
(mkdir-p lisp-dir)
|
||||
(copy-file source target)
|
||||
(with-directory-excursion lisp-dir
|
||||
(parameterize ((%emacs emacs))
|
||||
(emacs-batch-eval '(byte-compile-file "paredit.el"))))))))
|
||||
(home-page "http://mumble.net/~campbell/emacs/paredit/")
|
||||
(synopsis "Emacs minor mode for editing parentheses")
|
||||
(description
|
||||
"ParEdit (paredit.el) is a minor mode for performing structured editing
|
||||
of S-expression data. The typical example of this would be Lisp or Scheme
|
||||
source code.
|
||||
|
||||
ParEdit helps **keep parentheses balanced** and adds many keys for moving
|
||||
S-expressions and moving around in S-expressions. Its behavior can be jarring
|
||||
for those who may want transient periods of unbalanced parentheses, such as
|
||||
when typing parentheses directly or commenting out code line by line.")
|
||||
(license gpl3+)))
|
||||
|
||||
(define-public magit
|
||||
(package
|
||||
(name "magit")
|
||||
(version "1.2.1")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
"https://github.com/magit/magit/releases/download/"
|
||||
version "/" name "-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32 "1in48g5l5xdc9cf2apnpgx73mqlz2njrpi1w52dgql4qxv3kg6gr"))))
|
||||
(build-system gnu-build-system)
|
||||
(native-inputs `(("texinfo" ,texinfo)))
|
||||
(inputs `(("emacs" ,emacs)
|
||||
("git" ,git)
|
||||
("git:gui" ,git "gui")))
|
||||
(arguments
|
||||
`(#:modules ((guix build gnu-build-system)
|
||||
(guix build utils)
|
||||
(guix build emacs-utils))
|
||||
#:imported-modules ((guix build gnu-build-system)
|
||||
(guix build utils)
|
||||
(guix build emacs-utils))
|
||||
#:tests? #f ; no check target
|
||||
#:phases
|
||||
(alist-replace
|
||||
'configure
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(let ((out (assoc-ref outputs "out")))
|
||||
(substitute* "Makefile"
|
||||
(("/usr/local") out)
|
||||
(("/etc") (string-append out "/etc")))))
|
||||
(alist-cons-before
|
||||
'build 'patch-exec-paths
|
||||
(lambda* (#:key inputs #:allow-other-keys)
|
||||
(let ((git (assoc-ref inputs "git"))
|
||||
(git:gui (assoc-ref inputs "git:gui")))
|
||||
(emacs-substitute-variables "magit.el"
|
||||
("magit-git-executable" (string-append git "/bin/git"))
|
||||
("magit-gitk-executable" (string-append git:gui "/bin/gitk")))))
|
||||
%standard-phases))))
|
||||
(home-page "http://magit.github.io/")
|
||||
(synopsis "Emacs interface for the Git version control system")
|
||||
(description
|
||||
"With Magit, you can inspect and modify your Git repositories with Emacs.
|
||||
You can review and commit the changes you have made to the tracked files, for
|
||||
example, and you can browse the history of past changes. There is support for
|
||||
cherry picking, reverting, merging, rebasing, and other common Git
|
||||
operations.")
|
||||
(license gpl3+)))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Web browsing.
|
||||
;;;
|
||||
|
||||
(define-public emacs-w3m
|
||||
(package
|
||||
(name "emacs-w3m")
|
||||
(version "1.4.483+0.20120614")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://debian/pool/main/w/w3m-el/w3m-el_"
|
||||
version ".orig.tar.gz"))
|
||||
(sha256
|
||||
(base32 "0ms181gjavnfk79hhv5xl9llik4c6kj0w3c04kgyif8lcy2sxljx"))))
|
||||
(build-system gnu-build-system)
|
||||
(native-inputs `(("autoconf" ,autoconf)))
|
||||
(inputs `(("w3m" ,w3m)
|
||||
("imagemagick" ,imagemagick)
|
||||
("emacs" ,emacs)))
|
||||
(arguments
|
||||
'(#:modules ((guix build gnu-build-system)
|
||||
(guix build utils)
|
||||
(guix build emacs-utils))
|
||||
#:imported-modules ((guix build gnu-build-system)
|
||||
(guix build utils)
|
||||
(guix build emacs-utils))
|
||||
#:configure-flags
|
||||
(let ((out (assoc-ref %outputs "out")))
|
||||
(list (string-append "--with-lispdir="
|
||||
out "/share/emacs/site-lisp")
|
||||
(string-append "--with-icondir="
|
||||
out "/share/images/emacs-w3m")))
|
||||
#:tests? #f ; no check target
|
||||
#:phases
|
||||
(alist-cons-before
|
||||
'configure 'pre-configure
|
||||
(lambda _
|
||||
(zero? (system* "autoconf")))
|
||||
(alist-cons-before
|
||||
'build 'patch-exec-paths
|
||||
(lambda* (#:key inputs outputs #:allow-other-keys)
|
||||
(let ((out (assoc-ref outputs "out"))
|
||||
(w3m (assoc-ref inputs "w3m"))
|
||||
(imagemagick (assoc-ref inputs "imagemagick"))
|
||||
(coreutils (assoc-ref inputs "coreutils")))
|
||||
(emacs-substitute-variables "w3m.el"
|
||||
("w3m-command" (string-append w3m "/bin/w3m"))
|
||||
("w3m-touch-command" (string-append coreutils "/bin/touch"))
|
||||
("w3m-image-viewer" (string-append imagemagick "/bin/display"))
|
||||
("w3m-icon-directory" (string-append out
|
||||
"/share/images/emacs-w3m")))
|
||||
(emacs-substitute-variables "w3m-image.el"
|
||||
("w3m-imagick-convert-program" (string-append imagemagick
|
||||
"/bin/convert"))
|
||||
("w3m-imagick-identify-program" (string-append imagemagick
|
||||
"/bin/identify")))
|
||||
#t))
|
||||
(alist-replace
|
||||
'install
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(and (zero? (system* "make" "install" "install-icons"))
|
||||
(with-directory-excursion
|
||||
(string-append (assoc-ref outputs "out")
|
||||
"/share/emacs/site-lisp")
|
||||
(for-each delete-file '("ChangeLog" "ChangeLog.1"))
|
||||
#t)))
|
||||
%standard-phases)))))
|
||||
(home-page "http://emacs-w3m.namazu.org/")
|
||||
(synopsis "Simple Web browser for Emacs based on w3m")
|
||||
(description
|
||||
"Emacs-w3m is an emacs interface for the w3m web browser.")
|
||||
(license gpl2+)))
|
||||
|
||||
(define-public emacs-wget
|
||||
(package
|
||||
(name "emacs-wget")
|
||||
(version "0.5.0")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://debian/pool/main/w/wget-el/wget-el_"
|
||||
version ".orig.tar.gz"))
|
||||
(sha256
|
||||
(base32 "10byvyv9dk0ib55gfqm7bcpxmx2qbih1jd03gmihrppr2mn52nff"))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs `(("wget" ,wget)
|
||||
("emacs" ,emacs)))
|
||||
(arguments
|
||||
'(#:modules ((guix build gnu-build-system)
|
||||
(guix build utils)
|
||||
(guix build emacs-utils))
|
||||
#:imported-modules ((guix build gnu-build-system)
|
||||
(guix build utils)
|
||||
(guix build emacs-utils))
|
||||
#:tests? #f ; no check target
|
||||
#:phases
|
||||
(alist-replace
|
||||
'configure
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(substitute* "Makefile"
|
||||
(("/usr/local") (assoc-ref outputs "out"))
|
||||
(("/site-lisp/emacs-wget") "/site-lisp")))
|
||||
(alist-cons-before
|
||||
'build 'patch-exec-paths
|
||||
(lambda* (#:key inputs outputs #:allow-other-keys)
|
||||
(let ((wget (assoc-ref inputs "wget")))
|
||||
(emacs-substitute-variables "wget.el"
|
||||
("wget-command" (string-append wget "/bin/wget")))))
|
||||
%standard-phases))))
|
||||
(home-page "http://www.emacswiki.org/emacs/EmacsWget")
|
||||
(synopsis "Simple file downloader for Emacs based on wget")
|
||||
(description
|
||||
"Emacs-wget is an emacs interface for the wget file downloader.")
|
||||
(license gpl2+)))
|
||||
|
||||
@@ -0,0 +1,61 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2014 Marek Benc <merkur32@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/>.
|
||||
|
||||
(define-module (gnu packages enchant)
|
||||
#:use-module (gnu packages)
|
||||
#:use-module (gnu packages aspell)
|
||||
#:use-module (gnu packages glib)
|
||||
#:use-module (gnu packages pkg-config)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (guix licenses))
|
||||
|
||||
(define-public enchant
|
||||
(package
|
||||
(name "enchant")
|
||||
(version "1.6.0")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri
|
||||
(string-append "http://www.abisource.com/downloads/" name "/" version
|
||||
"/" name "-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32 "0zq9yw1xzk8k9s6x83n1f9srzcwdavzazn3haln4nhp9wxxrxb1g"))))
|
||||
|
||||
(build-system gnu-build-system)
|
||||
(inputs
|
||||
`(("aspell" ,aspell) ;; Currently, the only supported backend in Guix
|
||||
("glib" ,glib))) ;; is aspell. (This information might be old)
|
||||
(native-inputs
|
||||
`(("glib:bin" ,glib "bin")
|
||||
("pkg-config" ,pkg-config)))
|
||||
|
||||
(synopsis "Multi-backend spell-checking library wrapper")
|
||||
(description
|
||||
"On the surface, Enchant appears to be a generic spell checking library.
|
||||
Looking closer, you'll see the Enchant is more-or-less a fancy wrapper around
|
||||
the dlopen() system call.
|
||||
|
||||
Enchant steps in to provide uniformity and conformity on top of these libraries,
|
||||
and implement certain features that may be lacking in any individual provider
|
||||
library. Everything should \"just work\" for any and every definition of \"just
|
||||
working.\"")
|
||||
(home-page "http://www.abisource.com/projects/enchant")
|
||||
(license lgpl2.1+)))
|
||||
@@ -0,0 +1,66 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2014 Ian Denhardt <ian@zenhack.net>
|
||||
;;;
|
||||
;;; 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 feh)
|
||||
#:use-module (gnu packages)
|
||||
#:use-module (gnu packages image)
|
||||
#:use-module (gnu packages curl)
|
||||
#:use-module (gnu packages xorg)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module ((guix licenses) #:prefix license:))
|
||||
|
||||
(define-public feh
|
||||
(package
|
||||
(name "feh")
|
||||
(version "2.12")
|
||||
(home-page "https://feh.finalrewind.org/")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append home-page
|
||||
name "-" version ".tar.bz2"))
|
||||
(sha256
|
||||
(base32
|
||||
"0ckhidmsms2l5jycp0qf71jzmb3bpbhjq3bcgfpvfvszah7pmq30"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
'(#:phases (alist-delete 'configure %standard-phases)
|
||||
#:tests? #f
|
||||
#:make-flags
|
||||
(list "CC=gcc" (string-append "PREFIX=" (assoc-ref %outputs "out")))))
|
||||
(inputs `(("imlib2" ,imlib2)
|
||||
("curl" ,curl)
|
||||
("libpng" ,libpng)
|
||||
("libxt" ,libxt)
|
||||
("libx11" ,libx11)
|
||||
("libxinerama" ,libxinerama)))
|
||||
(synopsis "Fast and light imlib2-based image viewer")
|
||||
(description
|
||||
"feh is an X11 image viewer aimed mostly at console users.
|
||||
Unlike most other viewers, it does not have a fancy GUI, but simply
|
||||
displays images. It can also be used to set the desktop wallpaper.
|
||||
It is controlled via commandline arguments and configurable key/mouse
|
||||
actions.")
|
||||
|
||||
;; The license is really the Expat license, with additional wording in the
|
||||
;; 2nd paragraph: "acknowledgment shall be given in the documentation and
|
||||
;; software packages that this Software was used."
|
||||
(license (license:x11-style
|
||||
"file://COPYING"
|
||||
"See 'COPYING' in the distribution."))))
|
||||
+22
-8
@@ -27,22 +27,36 @@
|
||||
(define-public file
|
||||
(package
|
||||
(name "file")
|
||||
(version "5.18")
|
||||
(version "5.19")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "ftp://ftp.astron.com/pub/file/file-"
|
||||
version ".tar.gz"))
|
||||
(sha256 (base32
|
||||
"01xz106biz6x4h5ilymg5v3367djvgnfp4lm87132cjqdmqgn6b5"))))
|
||||
"0z1sgrcfy6d285kj5izy1yypf371bjl3247plh9ppk0svaxv714l"))
|
||||
(patches (list (search-patch "file-CVE-2014-3587.patch")))))
|
||||
(build-system gnu-build-system)
|
||||
(native-inputs
|
||||
;; This package depends upon a native install of itself.
|
||||
(if (%current-target-system) `(("file" ,file)) '() ))
|
||||
(synopsis "file, a file type guesser")
|
||||
|
||||
;; When cross-compiling, this package depends upon a native install of
|
||||
;; itself.
|
||||
(self-native-input? #t)
|
||||
|
||||
(synopsis "File type guesser")
|
||||
(description
|
||||
"The file command is a file type guesser, a command-line tool that tells
|
||||
you in words what kind of data a file contains. It does not rely on filename
|
||||
extentions to tell you the type of a file, but looks at the actual contents
|
||||
you in words what kind of data a file contains. It does not rely on filename
|
||||
extensions to tell you the type of a file, but looks at the actual contents
|
||||
of the file.")
|
||||
(license bsd-2)
|
||||
(home-page "http://www.darwinsys.com/file/")))
|
||||
|
||||
(define-public file-5.20 ;fix for CVE-2014-3710
|
||||
(package (inherit file)
|
||||
(version "5.20")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "ftp://ftp.astron.com/pub/file/file-"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0iyjs9z8kp43gz7gva4j67h4p0n53f7q8x3ibai9s01sp3xnphsv"))))))
|
||||
|
||||
@@ -0,0 +1,83 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2014 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/>.
|
||||
|
||||
(define-module (gnu packages firmware)
|
||||
#:use-module (guix licenses)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix git-download)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (gnu packages)
|
||||
#:use-module (gnu packages cmake)
|
||||
#:use-module (gnu packages cross-base)
|
||||
#:use-module (gnu packages perl))
|
||||
|
||||
(define-public ath9k-htc-firmware
|
||||
(package
|
||||
(name "ath9k-htc-firmware")
|
||||
(version "1.3.2")
|
||||
(source (origin
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
(url "https://github.com/qca/open-ath9k-htc-firmware.git")
|
||||
(commit version)))
|
||||
(sha256
|
||||
(base32
|
||||
"0dgqfp4cbky79vzjrdy3j462l8figymzrk2v0jalmmz3lkxw88ww"))
|
||||
(patches (list (search-patch "ath9k-htc-firmware-objcopy.patch")))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
'(#:phases (alist-cons-before
|
||||
'configure 'pre-configure
|
||||
(lambda* (#:key inputs #:allow-other-keys)
|
||||
(chdir "target_firmware")
|
||||
|
||||
;; 'configure' is a simple script that runs 'cmake' with
|
||||
;; the right flags.
|
||||
(substitute* "configure"
|
||||
(("^TOOLCHAIN=.*$")
|
||||
(string-append "TOOLCHAIN="
|
||||
(assoc-ref inputs "cross-gcc")
|
||||
"\n"))))
|
||||
(alist-replace
|
||||
'install
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(let* ((out (assoc-ref outputs "out"))
|
||||
(fw-dir (string-append out "/lib/firmware")))
|
||||
(mkdir-p fw-dir)
|
||||
(for-each (lambda (file)
|
||||
(copy-file file
|
||||
(string-append fw-dir "/"
|
||||
(basename file))))
|
||||
(find-files "." "\\.fw$"))
|
||||
#t))
|
||||
%standard-phases))
|
||||
#:tests? #f))
|
||||
|
||||
;; The firmware is cross-compiled using a "bare bones" compiler (no libc.)
|
||||
;; Use our own tool chain for that.
|
||||
(native-inputs `(("cross-gcc" ,xgcc-xtensa)
|
||||
("cross-binutils" ,(cross-binutils "xtensa-elf"))
|
||||
("cmake" ,cmake)
|
||||
("perl" ,perl)))
|
||||
(home-page "http://wireless.kernel.org/en/users/Drivers/ath9k_htc")
|
||||
(synopsis "Firmware for the Atheros AR7010 and AR9271 USB 802.11n NICs")
|
||||
(description
|
||||
"This is the firmware for the Qualcomm Atheros AR7010 and AR9271 USB
|
||||
802.11n NICs (aka. Wi-Fi USB dongles.) It is used by the ath9k driver of
|
||||
Linux-libre.")
|
||||
(license (bsd-style "http://directory.fsf.org/wiki/License:ClearBSD"))))
|
||||
@@ -50,8 +50,8 @@ discoverability, and friendliness. Fish has very user-friendly and powerful
|
||||
tab-completion, including descriptions of every completion, completion of
|
||||
strings with wildcards, and many completions for specific commands. It also
|
||||
has extensive and discoverable help. A special help command gives access to
|
||||
all the fish documentation in your web browser. Other features include smart
|
||||
all the fish documentation in your web browser. Other features include smart
|
||||
terminal handling based on terminfo, an easy to search history, and syntax
|
||||
highlighting. ")
|
||||
highlighting.")
|
||||
(home-page "http://fishshell.com/")
|
||||
(license gpl2)))
|
||||
|
||||
@@ -0,0 +1,129 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
|
||||
;;; Copyright © 2014 Manolis Fragkiskos Ragkousis <manolis837@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/>.
|
||||
|
||||
(define-module (gnu packages flashing-tools)
|
||||
#:use-module (guix licenses)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (gnu packages)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (gnu packages bison)
|
||||
#:use-module (gnu packages flex)
|
||||
#:use-module (gnu packages elf)
|
||||
#:use-module (gnu packages pkg-config)
|
||||
#:use-module (gnu packages libusb)
|
||||
#:use-module (gnu packages libftdi)
|
||||
#:use-module (gnu packages pciutils)
|
||||
#:use-module (gnu packages admin))
|
||||
|
||||
(define-public flashrom
|
||||
(package
|
||||
(name "flashrom")
|
||||
(version "0.9.7")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
"http://download.flashrom.org/releases/flashrom-"
|
||||
version ".tar.bz2"))
|
||||
(sha256
|
||||
(base32
|
||||
"1s9pc4yls2s1gcg2ar4q75nym2z5v6lxq36bl6lq26br00nj2mas"))
|
||||
(patches (list (search-patch "flashrom-use-libftdi1.patch")))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs `(("dmidecode" ,dmidecode)
|
||||
("pciutils" ,pciutils)
|
||||
("libusb" ,libusb)
|
||||
("libftdi" ,libftdi)))
|
||||
(native-inputs `(("pkg-config" ,pkg-config)))
|
||||
(arguments
|
||||
'(#:make-flags (list "CC=gcc" (string-append "PREFIX=" %output))
|
||||
#:tests? #f ; no 'check' target
|
||||
#:phases
|
||||
(alist-delete
|
||||
'configure
|
||||
(alist-cons-before
|
||||
'build 'patch-exec-paths
|
||||
(lambda* (#:key inputs #:allow-other-keys)
|
||||
(substitute* "dmi.c"
|
||||
(("\"dmidecode\"")
|
||||
(format #f "~S"
|
||||
(string-append (assoc-ref inputs "dmidecode")
|
||||
"/sbin/dmidecode")))))
|
||||
%standard-phases))))
|
||||
(home-page "http://flashrom.org/")
|
||||
(synopsis "Identify, read, write, erase, and verify ROM/flash chips")
|
||||
(description
|
||||
"flashrom is a utility for identifying, reading, writing,
|
||||
verifying and erasing flash chips. It is designed to flash
|
||||
BIOS/EFI/coreboot/firmware/optionROM images on mainboards,
|
||||
network/graphics/storage controller cards, and various other
|
||||
programmer devices.")
|
||||
(license gpl2)))
|
||||
|
||||
(define-public avrdude
|
||||
(package
|
||||
(name "avrdude")
|
||||
(version "6.1")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://savannah/avrdude/avrdude-"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0frxg0q09nrm95z7ymzddx7ysl77ilfbdix1m81d9jjpiv5bm64y"))
|
||||
(patches (list (search-patch "avrdude-fix-libusb.patch")))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs
|
||||
`(("libelf" ,libelf)
|
||||
("libusb" ,libusb)
|
||||
("libftdi" ,libftdi)))
|
||||
(native-inputs
|
||||
`(("bison" ,bison)
|
||||
("flex" ,flex)))
|
||||
(home-page "http://www.nongnu.org/avrdude/")
|
||||
(synopsis "AVR downloader and uploader")
|
||||
(description
|
||||
"AVRDUDE is a utility to download/upload/manipulate the ROM and
|
||||
EEPROM contents of AVR microcontrollers using the in-system programming
|
||||
technique (ISP).")
|
||||
(license gpl2+)))
|
||||
|
||||
(define-public dfu-programmer
|
||||
(package
|
||||
(name "dfu-programmer")
|
||||
(version "0.7.0")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://sourceforge/dfu-programmer/dfu-programmer-"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"17lglglk5xrqd2n0impg5bkq4j96qc51cw3kzcghzmzmn6fvg3gf"))
|
||||
(patches (list (search-patch "dfu-programmer-fix-libusb.patch")))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs
|
||||
`(("libusb" ,libusb)))
|
||||
(home-page "http://dfu-programmer.github.io/")
|
||||
(synopsis "Device firmware update programmer for Atmel chips")
|
||||
(description
|
||||
"Dfu-programmer is a multi-platform command-line programmer for Atmel
|
||||
(8051, AVR, XMEGA & AVR32) chips with a USB bootloader supporting ISP")
|
||||
(license gpl2+)))
|
||||
@@ -1,5 +1,5 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -62,18 +62,18 @@
|
||||
("indent" ,indent))))
|
||||
(propagated-inputs `(("m4" ,m4)))
|
||||
(home-page "http://flex.sourceforge.net/")
|
||||
(synopsis "A fast lexical analyser generator")
|
||||
(synopsis "Fast lexical analyser generator")
|
||||
(description
|
||||
"Flex is a tool for generating scanners. A scanner, sometimes
|
||||
"Flex is a tool for generating scanners. A scanner, sometimes
|
||||
called a tokenizer, is a program which recognizes lexical patterns in
|
||||
text. The flex program reads user-specified input files, or its standard
|
||||
text. The flex program reads user-specified input files, or its standard
|
||||
input if no file names are given, for a description of a scanner to
|
||||
generate. The description is in the form of pairs of regular expressions
|
||||
and C code, called rules. Flex generates a C source file named,
|
||||
\"lex.yy.c\", which defines the function yylex(). The file \"lex.yy.c\"
|
||||
can be compiled and linked to produce an executable. When the executable
|
||||
generate. The description is in the form of pairs of regular expressions
|
||||
and C code, called rules. Flex generates a C source file named,
|
||||
\"lex.yy.c\", which defines the function yylex(). The file \"lex.yy.c\"
|
||||
can be compiled and linked to produce an executable. When the executable
|
||||
is run, it analyzes its input for occurrences of text matching the
|
||||
regular expressions for each rule. Whenever it finds a match, it
|
||||
regular expressions for each rule. Whenever it finds a match, it
|
||||
executes the corresponding C code.")
|
||||
(license (bsd-style "file://COPYING"
|
||||
"See COPYING in the distribution."))))
|
||||
|
||||
@@ -31,7 +31,8 @@
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "http://fltk.org/pub/fltk/" version "/fltk-" version "-source.tar.gz"))
|
||||
(uri (string-append "http://fltk.org/pub/fltk/" version
|
||||
"/fltk-" version "-source.tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1974brlk723095vf8z72kazq1cbqr9a51kq6b0xda6zkjkgl8q0p"))))
|
||||
@@ -51,9 +52,9 @@
|
||||
%standard-phases)))
|
||||
(home-page "https://www.fltk.org")
|
||||
(synopsis "3D C++ GUI library")
|
||||
(description "FLTK is a C++ GUI toolkit providing modern GUI functionality without the
|
||||
bloat. It supports 3D graphics via OpenGL and its built-in GLUT emulation.
|
||||
FLTK is designed to be small and modular enough to be statically linked, but
|
||||
works fine as a shared library. FLTK also includes an excellent UI builder
|
||||
called FLUID that can be used to create applications in minutes.")
|
||||
(description "FLTK is a C++ GUI toolkit providing modern GUI functionality
|
||||
without the bloat. It supports 3D graphics via OpenGL and its built-in GLUT
|
||||
emulation. FLTK is designed to be small and modular enough to be statically
|
||||
linked, but works fine as a shared library. FLTK also includes an excellent
|
||||
UI builder called FLUID that can be used to create applications in minutes.")
|
||||
(license lgpl2.0))) ; plus certain additional permissions
|
||||
|
||||
+43
-3
@@ -1,6 +1,7 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
|
||||
;;; Copyright © 2014 Joshua Grant <tadni@riseup.net>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -18,14 +19,17 @@
|
||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gnu packages fonts)
|
||||
#:use-module ((guix licenses)
|
||||
#:renamer (symbol-prefix-proc 'license:))
|
||||
#:use-module ((guix licenses) #:prefix license:)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (guix build-system trivial)
|
||||
#:use-module ((gnu packages base)
|
||||
#:select (tar))
|
||||
#:use-module (gnu packages compression))
|
||||
#:use-module (gnu packages compression)
|
||||
#:use-module (gnu packages perl)
|
||||
#:use-module (gnu packages xorg)
|
||||
#:use-module (gnu packages pkg-config))
|
||||
|
||||
(define-public ttf-dejavu
|
||||
(package
|
||||
@@ -198,3 +202,39 @@ package provides the TrueType (TTF) files.")
|
||||
(PostScript Type0, TrueType, OpenType...) fonts covering the ISO
|
||||
10646/Unicode UCS (Universal Character Set).")
|
||||
(license license:gpl3+)))
|
||||
|
||||
(define-public terminus-font
|
||||
(package
|
||||
(name "terminus-font")
|
||||
(version "4.39")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
"mirror://sourceforge/project/terminus-font/terminus-font-"
|
||||
version
|
||||
"/terminus-font-"
|
||||
version
|
||||
".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1gzmn7zakvy6yrvmswyjfklnsvqrjm0imhq8rjws8rdkhqwkh21i"))))
|
||||
(build-system gnu-build-system)
|
||||
(native-inputs
|
||||
`(("pkg-config" ,pkg-config)
|
||||
("perl" ,perl)
|
||||
("bdftopcf" ,bdftopcf)
|
||||
("font-util", font-util)
|
||||
("mkfontdir" ,mkfontdir)))
|
||||
(arguments
|
||||
`(#:configure-flags (list
|
||||
;; install fonts into subdirectory of package output
|
||||
;; instead of font-util-?.?.?/share/fonts/X11
|
||||
(string-append "--with-fontrootdir="
|
||||
%output "/share/fonts/X11"))
|
||||
#: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.")
|
||||
(license license:silofl1.1)))
|
||||
|
||||
+211
-15
@@ -1,5 +1,6 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
|
||||
;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr>
|
||||
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -20,11 +21,20 @@
|
||||
#:use-module (gnu packages)
|
||||
#:use-module (gnu packages compression)
|
||||
#:use-module (gnu packages ghostscript)
|
||||
#:use-module (gnu packages perl)
|
||||
#:use-module (gnu packages pkg-config)
|
||||
#:use-module (gnu packages autotools)
|
||||
#:use-module (gnu packages gettext)
|
||||
#:use-module (gnu packages python)
|
||||
#:use-module (gnu packages image)
|
||||
#:use-module (gnu packages glib)
|
||||
#:use-module (gnu packages xorg)
|
||||
#:use-module (gnu packages gtk)
|
||||
#:use-module (gnu packages xml)
|
||||
#:use-module ((guix licenses) #:renamer (symbol-prefix-proc 'license:))
|
||||
#:use-module ((guix licenses) #:prefix license:)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix build-system cmake)
|
||||
#:use-module (guix build-system gnu))
|
||||
|
||||
(define-public freetype
|
||||
@@ -52,12 +62,12 @@
|
||||
(symlink (string-append include "/freetype2/freetype")
|
||||
(string-append include "/freetype"))))
|
||||
%standard-phases)))
|
||||
(synopsis "Freetype, a library to render fonts")
|
||||
(synopsis "Font rendering library")
|
||||
(description
|
||||
"Freetype is a library that can be used by applications to access the
|
||||
contents of font files. It provides a uniform interface to access font files.
|
||||
contents of font files. It provides a uniform interface to access font files.
|
||||
It supports both bitmap and scalable formats, including TrueType, OpenType,
|
||||
Type1, CID, CFF, Windows FON/FNT, X11 PCF, and others. It supports high-speed
|
||||
Type1, CID, CFF, Windows FON/FNT, X11 PCF, and others. It supports high-speed
|
||||
anti-aliased glyph bitmap generation with 256 gray levels.")
|
||||
(license license:freetype) ; some files have other licenses
|
||||
(home-page "http://www.freetype.org/")))
|
||||
@@ -87,7 +97,7 @@ anti-aliased glyph bitmap generation with 256 gray levels.")
|
||||
(string-append "--with-add-fonts="
|
||||
(assoc-ref %build-inputs "gs-fonts")
|
||||
"/share/fonts"))))
|
||||
(synopsis "Fontconfig, a library for configuring and customising font access.")
|
||||
(synopsis "Library for configuring and customizing font access")
|
||||
(description
|
||||
"Fontconfig can discover new fonts when installed automatically;
|
||||
perform font name substitution, so that appropriate alternative fonts can
|
||||
@@ -118,16 +128,16 @@ high quality, anti-aliased and subpixel rendered text on a display.")
|
||||
`(#:tests? #f ; no test target
|
||||
#:make-flags
|
||||
'("without_doc")))
|
||||
(synopsis "T1lib, a library for generating bitmaps from type 1 fonts.")
|
||||
(synopsis "Library for generating bitmaps from Type 1 fonts")
|
||||
(description
|
||||
"T1lib is a library for generating/rasterising bitmaps from Type 1 fonts.
|
||||
It is based on the code of the X11 rasteriser of the X11 project.
|
||||
|
||||
The bitmaps created by t1lib are returned in a data structure with type
|
||||
GLYPH. This special GLYPH-type is also used in the X11 window system to
|
||||
describe character bitmaps. It contains the bitmap data as well as some
|
||||
metric information. But t1lib is in itself entirely independent of the
|
||||
X11-system or any other graphical user interface. ")
|
||||
GLYPH. This special GLYPH-type is also used in the X11 window system to
|
||||
describe character bitmaps. It contains the bitmap data as well as some
|
||||
metric information. But t1lib is in itself entirely independent of the
|
||||
X11-system or any other graphical user interface.")
|
||||
(license license:gpl2)
|
||||
(home-page "http://www.t1lib.org/")))
|
||||
|
||||
@@ -146,13 +156,13 @@ X11-system or any other graphical user interface. ")
|
||||
(patches (list (search-patch "teckit-cstdio.patch")))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs `(("zlib" ,zlib)))
|
||||
(synopsis "TECkit, a toolkit for encoding conversions")
|
||||
(synopsis "Toolkit for encoding conversions")
|
||||
(description
|
||||
"TECkit is a low-level toolkit intended to be used by other applications
|
||||
that need to perform encoding conversions (e.g., when importing legacy data
|
||||
into a Unicode-based application). The primary component of the TECkit
|
||||
into a Unicode-based application). The primary component of the TECkit
|
||||
package is therefore a library that performs conversions; this is the
|
||||
\"TECkit engine\". The engine relies on mapping tables in a specific binary
|
||||
\"TECkit engine\". The engine relies on mapping tables in a specific binary
|
||||
format (for which documentation is available); there is a compiler that
|
||||
creates such tables from a human-readable mapping description (a simple
|
||||
text file).
|
||||
@@ -161,9 +171,195 @@ To facilitate the development and testing of mapping tables for TECkit,
|
||||
several applications are also included in the current package; these
|
||||
include simple tools for applying conversions to plain-text and Standard
|
||||
Format files, as well as both command-line and simple GUI versions of the
|
||||
TECkit compiler. However, it is not intended that these tools will be the
|
||||
TECkit compiler. However, it is not intended that these tools will be the
|
||||
primary means by which end users perform conversions, and they have not
|
||||
been designed, tested, and debugged to the extent that general-purpose
|
||||
applications should be.")
|
||||
(license license:lgpl2.1+)
|
||||
(home-page "http://scripts.sil.org/cms/scripts/page.php?cat_id=teckit")))
|
||||
|
||||
(define-public graphite2
|
||||
(package
|
||||
(name "graphite2")
|
||||
(version "1.2.4")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
"mirror://sourceforge/silgraphite/graphite2/graphite2-"
|
||||
version ".tgz"))
|
||||
(sha256
|
||||
(base32
|
||||
"00xhv1mp640fr3wmdzwn4yz0g56jd4r9fb7b02mc1g19h0bdbhsb"))))
|
||||
(build-system cmake-build-system)
|
||||
(inputs
|
||||
`(("freetype" ,freetype)
|
||||
("perl" ,perl)
|
||||
("python" ,python-2))) ; because of "import imap" in tests
|
||||
(synopsis "Reimplementation of the SIL Graphite text processing engine")
|
||||
(description
|
||||
"Graphite2 is a reimplementation of the SIL Graphite text processing
|
||||
engine. Graphite is a smart font technology designed to facilitate the
|
||||
process known as shaping. This process takes an input Unicode text string
|
||||
and returns a sequence of positioned glyphids from the font.")
|
||||
(license license:lgpl2.1+)
|
||||
(home-page "http://projects.palaso.org/projects/graphitedev")))
|
||||
|
||||
(define-public potrace
|
||||
(package
|
||||
(name "potrace")
|
||||
(version "1.11")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://sourceforge/potrace/potrace-"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1bbyl7jgigawmwc8r14znv8lb6lrcxh8zpvynrl6s800dr4yp9as"))))
|
||||
(build-system gnu-build-system)
|
||||
(native-inputs `(("ghostscript" ,ghostscript))) ;for tests
|
||||
(inputs `(("zlib" ,zlib)))
|
||||
(arguments
|
||||
`(#:configure-flags
|
||||
`("--with-libpotrace"))) ; install library and headers
|
||||
(synopsis "Transform bitmaps into vector graphics")
|
||||
(description
|
||||
"Potrace is a tool for tracing a bitmap, which means, transforming a
|
||||
bitmap into a smooth, scalable image. The input is a bitmap (PBM, PGM, PPM,
|
||||
or BMP format), and the default output is an encapsulated PostScript
|
||||
file (EPS). A typical use is to create EPS files from scanned data, such as
|
||||
company or university logos, handwritten notes, etc. The resulting image is
|
||||
not \"jaggy\" like a bitmap, but smooth. It can then be rendered at any
|
||||
resolution.")
|
||||
(license license:gpl2+)
|
||||
(home-page "http://potrace.sourceforge.net/")))
|
||||
|
||||
(define-public libspiro
|
||||
(package
|
||||
(name "libspiro")
|
||||
(version "20071029")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://sourceforge/libspiro/libspiro/"
|
||||
version "/libspiro_src-" version ".tar.bz2"))
|
||||
(sha256
|
||||
(base32
|
||||
"1kylz8pvwnb85yya150r9i6mhbpzx38f32qy523qg3ylgd9b3zhy"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments `(#:tests? #f)) ;no tests
|
||||
(synopsis "Clothoid to bezier conversion library")
|
||||
(description
|
||||
"Raph Levien's Spiro package as a library. A mechanism for drawing
|
||||
smooth contours with constant curvature at the spline joins.")
|
||||
(license license:gpl2+)
|
||||
(home-page "http://libspiro.sourceforge.net/")))
|
||||
|
||||
(define-public libuninameslist
|
||||
(package
|
||||
(name "libuninameslist")
|
||||
(version "0.4.20140731")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "https://github.com/fontforge/libuninameslist/"
|
||||
"archive/" version ".tar.gz"))
|
||||
(file-name (string-append name "-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"016zxffpc8iwpxxmnjkdirn6dsbcvdb2wjdrp123sf79f4nsynyj"))))
|
||||
(build-system gnu-build-system)
|
||||
(native-inputs `(("autoconf" ,autoconf)
|
||||
("automake" ,automake)
|
||||
("libtool" ,libtool)
|
||||
("libtool-bin" ,libtool "bin")))
|
||||
(arguments
|
||||
`(#:phases (alist-cons-before
|
||||
'configure 'bootstrap
|
||||
(lambda _
|
||||
(zero? (system* "autoreconf" "-vi")))
|
||||
%standard-phases)))
|
||||
(synopsis "Unicode names and annotation list")
|
||||
(description
|
||||
"LibUniNamesList holds www.unicode.org Nameslist.txt data which can be
|
||||
useful for programs that need Unicode \"Names\", \"Annotations\", and block
|
||||
definitions.")
|
||||
(license license:gpl2)
|
||||
(home-page "https://github.com/fontforge/libuninameslist")))
|
||||
|
||||
(define-public fontforge
|
||||
(package
|
||||
(name "fontforge")
|
||||
(version "20120731-b") ;aka 1.0
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://sourceforge/fontforge/fontforge_full-"
|
||||
version ".tar.bz2"))
|
||||
(sha256 (base32
|
||||
"1dhg0i2pf76j40cb9g1wzpag21fgarpjaad0hdbk27i1zz588q8v"))))
|
||||
(build-system gnu-build-system)
|
||||
;; TODO: Add python for scripting support.
|
||||
(inputs `(("gettext" ,gnu-gettext)
|
||||
("libtiff" ,libtiff)
|
||||
("libjpeg" ,libjpeg)
|
||||
("libpng" ,libpng)
|
||||
("giflib" ,giflib) ;needs giflib 4.*
|
||||
("libxml2" ,libxml2)
|
||||
("libX11" ,libx11)
|
||||
("libXi" ,libxi)
|
||||
("libICE" ,libice)
|
||||
("libSM" ,libsm)
|
||||
("freetype" ,freetype)
|
||||
("potrace" ,potrace)
|
||||
("libspiro" ,libspiro)
|
||||
("zlib" ,zlib)
|
||||
("cairo" ,cairo)
|
||||
("fontconfig" ,fontconfig) ;dlopen'd
|
||||
("libuninameslist" ,libuninameslist)
|
||||
("pango" ,pango)
|
||||
("glib" ,glib))) ;needed for pango detection
|
||||
(arguments
|
||||
'(#:configure-flags `("--enable-double")
|
||||
#:tests? #f
|
||||
#:phases
|
||||
(alist-cons-before
|
||||
'configure 'patch-configure
|
||||
(lambda* (#:key inputs #:allow-other-keys)
|
||||
(let ((libxml2 (assoc-ref inputs "libxml2"))
|
||||
(cairo (assoc-ref inputs "cairo"))
|
||||
(pango (assoc-ref inputs "pango")))
|
||||
(substitute* "configure"
|
||||
;; configure looks for a directory to be present to determine
|
||||
;; whether libxml2 is available, rather than checking for the
|
||||
;; library or headers. Point it to the correct directory.
|
||||
(("/usr/include/libxml2")
|
||||
(string-append libxml2 "/include/libxml2"))
|
||||
;; Similary, the search directories for cairo and pango are
|
||||
;; hard-coded.
|
||||
(("gww_prefix in.*") (string-append "gww_prefix in "
|
||||
cairo " " pango "\n")))))
|
||||
(alist-cons-after
|
||||
'install 'set-library-path
|
||||
(lambda* (#:key inputs outputs #:allow-other-keys)
|
||||
(let ((out (assoc-ref outputs "out"))
|
||||
(potrace (string-append (assoc-ref inputs "potrace") "/bin")))
|
||||
(wrap-program (string-append out "/bin/fontforge")
|
||||
;; Fontforge dynamically opens libraries.
|
||||
`("LD_LIBRARY_PATH" ":" prefix
|
||||
,(map (lambda (input)
|
||||
(string-append (assoc-ref inputs input)
|
||||
"/lib"))
|
||||
'("libtiff" "libjpeg" "libpng" "giflib"
|
||||
"libxml2" "zlib" "libspiro" "freetype"
|
||||
"pango" "cairo" "fontconfig")))
|
||||
;; Checks for potrace program at runtime
|
||||
`("PATH" ":" prefix (,potrace)))))
|
||||
%standard-phases))))
|
||||
(synopsis "Outline font editor")
|
||||
(description
|
||||
"FontForge allows you to create and modify postscript, truetype and
|
||||
opentype fonts. You can save fonts in many different outline formats, and
|
||||
generate bitmaps.")
|
||||
(license license:bsd-3)
|
||||
(home-page "http://fontforge.org/")))
|
||||
|
||||
@@ -27,14 +27,14 @@
|
||||
(define-public freeipmi
|
||||
(package
|
||||
(name "freeipmi")
|
||||
(version "1.4.1")
|
||||
(version "1.4.5")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnu/freeipmi/freeipmi-"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1qpr4h46zmbk82w4fpijimzsdpgyr0fdnsinpsp5cvxy5pcikbd6"))))
|
||||
"033zakrk3kvi4y41kslicr90b3yb2kj052cl6nbja7ybn70y9nkz"))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs
|
||||
`(("readline" ,readline) ("libgcrypt" ,libgcrypt)))
|
||||
|
||||
@@ -0,0 +1,45 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2014 Marek Benc <merkur32@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/>.
|
||||
|
||||
(define-module (gnu packages fribidi)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (guix licenses))
|
||||
|
||||
(define-public fribidi
|
||||
(package
|
||||
(name "fribidi")
|
||||
(version "0.19.6")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri
|
||||
(string-append "http://fribidi.org/download/" name "-" version
|
||||
".tar.bz2"))
|
||||
(sha256
|
||||
(base32 "0zg1hpaml34ny74fif97j7ngrshlkl3wk3nja3gmlzl17i1bga6b"))))
|
||||
|
||||
(build-system gnu-build-system)
|
||||
(synopsis "Implementation of the Unicode bidirectional algorithm")
|
||||
(description
|
||||
"GNU FriBidi is an implementation of the Unicode Bidirectional
|
||||
Algorithm. This algorithm is used to properly display text in left-to-right
|
||||
or right-to-left ordering as necessary.")
|
||||
(home-page "http://fribidi.org/")
|
||||
(license lgpl2.1+)))
|
||||
+425
-13
@@ -3,6 +3,9 @@
|
||||
;;; Copyright © 2014 David Thompson <dthompson2@worcester.edu>
|
||||
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
|
||||
;;; Copyright © 2014 Cyrill Schenkel <cyrill.schenkel@gmail.com>
|
||||
;;; Copyright © 2014 Sylvain Beucler <beuc@beuc.net>
|
||||
;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2014 Sou Bunnbu <iyzsong@gmail.com>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -20,10 +23,13 @@
|
||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gnu packages games)
|
||||
#:use-module (guix licenses)
|
||||
#:use-module ((guix licenses) #:prefix license:)
|
||||
#:use-module (guix utils)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix download)
|
||||
#:use-module (gnu packages)
|
||||
#:use-module (gnu packages base)
|
||||
#:use-module (gnu packages admin)
|
||||
#:use-module (gnu packages boost)
|
||||
#:use-module (gnu packages gettext)
|
||||
#:use-module (gnu packages gl)
|
||||
@@ -38,10 +44,25 @@
|
||||
#:use-module (gnu packages readline)
|
||||
#:use-module (gnu packages xorg)
|
||||
#:use-module (gnu packages pkg-config)
|
||||
#:use-module (gnu packages sqlite)
|
||||
#:use-module (gnu packages databases)
|
||||
#:use-module (gnu packages sdl)
|
||||
#:use-module (gnu packages texinfo)
|
||||
#:use-module (guix build-system gnu))
|
||||
#:use-module (gnu packages check)
|
||||
#:use-module (gnu packages fontutils)
|
||||
#:use-module (gnu packages bash)
|
||||
#:use-module (gnu packages perl)
|
||||
#:use-module (gnu packages qt)
|
||||
#:use-module (gnu packages compression)
|
||||
#:use-module (gnu packages pulseaudio)
|
||||
#:use-module (gnu packages linux)
|
||||
#:use-module (gnu packages zip)
|
||||
#:use-module (gnu packages xiph)
|
||||
#:use-module (gnu packages curl)
|
||||
#:use-module (gnu packages lua)
|
||||
#:use-module (guix build-system trivial)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (guix build-system cmake)
|
||||
#:use-module (guix build-system trivial))
|
||||
|
||||
(define-public gnubg
|
||||
(package
|
||||
@@ -72,7 +93,7 @@ teaching the game. It has an advanced evaluation engine based on artificial
|
||||
neural networks suitable for both beginners and advanced players. In
|
||||
addition to a command-line interface, it also features an attractive, 3D
|
||||
representation of the playing board.")
|
||||
(license gpl3+)))
|
||||
(license license:gpl3+)))
|
||||
|
||||
(define-public gnubik
|
||||
(package
|
||||
@@ -100,9 +121,9 @@ representation of the playing board.")
|
||||
"GNUbik is a puzzle game in which you must manipulate a cube to make
|
||||
each of its faces have a uniform color. The game is customizable, allowing
|
||||
you to set the size of the cube (the default is 3x3) or to change the colors.
|
||||
You may even apply photos to the faces instead of colors. The game is
|
||||
You may even apply photos to the faces instead of colors. The game is
|
||||
scriptable with Guile.")
|
||||
(license gpl3+)))
|
||||
(license license:gpl3+)))
|
||||
|
||||
(define-public abbaye
|
||||
(package
|
||||
@@ -164,7 +185,7 @@ France. The Cathars, who preach about good Christian beliefs, were being
|
||||
expelled by the Catholic Church out of the Languedoc region in France. One of
|
||||
them, called Jean Raymond, found an old church in which to hide, not knowing
|
||||
that beneath its ruins lay buried an ancient evil.")
|
||||
(license gpl3+)))
|
||||
(license license:gpl3+)))
|
||||
|
||||
(define-public pingus
|
||||
(package
|
||||
@@ -210,7 +231,7 @@ giving them commands, like build a bridge, dig a hole, or redirect all animals
|
||||
in the other direction. Multiple such commands are necessary to reach the
|
||||
level's exit. The game is presented in a 2D side view.")
|
||||
;; Some source files are under bsd-3 and gpl2+ licenses.
|
||||
(license gpl3+)))
|
||||
(license license:gpl3+)))
|
||||
|
||||
(define-public talkfilters
|
||||
(package
|
||||
@@ -229,8 +250,8 @@ level's exit. The game is presented in a 2D side view.")
|
||||
(description "The GNU Talk Filters are programs that convert English text
|
||||
into stereotyped or otherwise humorous dialects. The filters are provided as
|
||||
a C library, so they can easily be integrated into other programs.")
|
||||
(license gpl2+)))
|
||||
|
||||
(license license:gpl2+)))
|
||||
|
||||
(define-public cmatrix
|
||||
(package
|
||||
(name "cmatrix")
|
||||
@@ -263,7 +284,7 @@ a C library, so they can easily be integrated into other programs.")
|
||||
based on the screensaver from the movie's website. It works with terminal
|
||||
settings up to 132x300 and can scroll lines all at the same rate or
|
||||
asynchronously and at a user-defined speed.")
|
||||
(license gpl2+)))
|
||||
(license license:gpl2+)))
|
||||
|
||||
(define-public chess
|
||||
(package
|
||||
@@ -283,7 +304,88 @@ asynchronously and at a user-defined speed.")
|
||||
(description "GNU Chess is a chess engine. It allows you to compete
|
||||
against the computer in a game of chess, either through the default terminal
|
||||
interface or via an external visual interface such as GNU XBoard.")
|
||||
(license gpl3+)))
|
||||
(license license:gpl3+)))
|
||||
|
||||
(define freedink-engine
|
||||
(package
|
||||
(name "freedink-engine")
|
||||
(version "108.4")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnu/freedink/freedink-" version
|
||||
".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"08c51imfjfcydm7h0va09z8qfw5nc837bi2x754ni2z737hb5kw2"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments `(#:configure-flags '("--disable-embedded-resources")))
|
||||
(native-inputs `(("gettext" ,gnu-gettext)
|
||||
("pkg-config" ,pkg-config)))
|
||||
(inputs `(("sdl" ,sdl)
|
||||
("sdl-image" ,sdl-image)
|
||||
("sdl-mixer" ,sdl-mixer)
|
||||
("sdl-ttf" ,sdl-ttf)
|
||||
("sdl-gfx" ,sdl-gfx)
|
||||
("fontconfig" ,fontconfig)
|
||||
("check" ,check)))
|
||||
(home-page "http://www.gnu.org/software/freedink/")
|
||||
(synopsis "Twisted adventures of young pig farmer Dink Smallwood")
|
||||
(description
|
||||
"GNU FreeDink is a free and portable re-implementation of the engine
|
||||
for the role-playing game Dink Smallwood. It supports not only the original
|
||||
game data files but it also supports user-produced game mods or \"D-Mods\".
|
||||
To that extent, it also includes a front-end for managing all of your D-Mods.")
|
||||
(license license:gpl3+)))
|
||||
|
||||
(define freedink-data
|
||||
(package
|
||||
(name "freedink-data")
|
||||
(version "1.08.20140901")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnu/freedink/freedink-data-"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"04f1aa8gfz30qkgv7chjz5n1s8v5hbqs01h2113cq1ylm3isd5sp"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
`(#:phases (alist-delete 'configure (alist-delete 'check %standard-phases))
|
||||
#:make-flags (list (string-append "PREFIX=" (assoc-ref %outputs "out")))))
|
||||
(home-page "http://www.gnu.org/software/freedink/")
|
||||
(synopsis "Game data for GNU Freedink")
|
||||
(description
|
||||
"This package contains the game data of GNU Freedink.")
|
||||
(license license:gpl3+)))
|
||||
|
||||
;; TODO: Add freedink-dfarc when there's a wxWidgets package.
|
||||
|
||||
(define-public freedink
|
||||
;; This is a wrapper that tells the engine where to find the data.
|
||||
(package (inherit freedink-engine)
|
||||
(name "freedink")
|
||||
(build-system trivial-build-system)
|
||||
(arguments
|
||||
'(#:builder (begin
|
||||
(use-modules (guix build utils))
|
||||
|
||||
(let* ((output (assoc-ref %outputs "out"))
|
||||
(bin (string-append output "/bin"))
|
||||
(executable (string-append bin "/freedink")))
|
||||
(mkdir-p bin)
|
||||
(call-with-output-file executable
|
||||
(lambda (port)
|
||||
(format port "#!~a/bin/sh
|
||||
exec ~a/bin/freedink -refdir ~a/share/dink\n"
|
||||
(assoc-ref %build-inputs "bash")
|
||||
(assoc-ref %build-inputs "engine")
|
||||
(assoc-ref %build-inputs "data"))
|
||||
(chmod port #o777)))))
|
||||
#:modules ((guix build utils))))
|
||||
(inputs `(("engine" ,freedink-engine)
|
||||
("data" ,freedink-data)
|
||||
("bash" ,bash)))
|
||||
(native-inputs '())))
|
||||
|
||||
(define-public xboard
|
||||
(package
|
||||
@@ -320,4 +422,314 @@ including international chess, xiangqi (Chinese chess), shogi (Japanese chess)
|
||||
and Makruk. Several lesser-known variants are also supported. It presents a
|
||||
fully interactive graphical interface and it can load and save games in the
|
||||
Portable Game Notation.")
|
||||
(license gpl3+)))
|
||||
(license license:gpl3+)))
|
||||
|
||||
|
||||
(define-public xboing
|
||||
(package
|
||||
(name "xboing")
|
||||
(version "2.4")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "http://www.techrescue.org/xboing/xboing"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32 "16m2si8wmshxpifk861vhpqviqxgcg8bxj6wfw8hpnm4r2w9q0b7"))))
|
||||
(arguments
|
||||
`(#:tests? #f
|
||||
#:phases
|
||||
(alist-replace
|
||||
'configure
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
|
||||
(substitute* "Imakefile"
|
||||
(("XPMINCLUDE[\t ]*= -I/usr/X11/include/X11")
|
||||
(string-append "XPMINCLUDE = -I" (assoc-ref %build-inputs "libxpm")
|
||||
"/include/X11")))
|
||||
|
||||
(substitute* "Imakefile"
|
||||
(("XBOING_DIR = \\.") "XBOING_DIR=$(PROJECTROOT)"))
|
||||
|
||||
;; FIXME: HIGH_SCORE_FILE should be set to somewhere writeable
|
||||
|
||||
(zero? (system* "xmkmf" "-a"
|
||||
(string-append "-DProjectRoot="
|
||||
(assoc-ref outputs "out")))))
|
||||
(alist-replace 'install
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(and
|
||||
(zero? (system* "make" "install.man"))
|
||||
(zero? (system* "make" "install"))))
|
||||
%standard-phases))))
|
||||
(inputs `(("libx11" ,libx11)
|
||||
("libxext" ,libxext)
|
||||
("libxpm" ,libxpm)))
|
||||
(native-inputs `(("imake" ,imake)
|
||||
("inetutils" ,inetutils)
|
||||
("makedepend" ,makedepend)))
|
||||
(build-system gnu-build-system)
|
||||
(home-page "http://www.techrescue.org/xboing")
|
||||
(synopsis "Ball and paddle game")
|
||||
(description "XBoing is a blockout type game where you have a paddle which
|
||||
you control to bounce a ball around the game zone destroying blocks with a
|
||||
proton ball. Each block carries a different point value. The more blocks you
|
||||
destroy, the better your score. The person with the highest score wins.")
|
||||
(license (license:x11-style "file://COPYING"
|
||||
"Very similar to the X11 licence."))))
|
||||
|
||||
(define-public gtypist
|
||||
(package
|
||||
(name "gtypist")
|
||||
(version "2.9.5")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnu/gtypist/gtypist-"
|
||||
version ".tar.xz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0xzrkkmj0b1dw3yr0m9hml2y634cc4h61im6zwcq57s7285z8fn1"))
|
||||
(modules '((guix build utils)))
|
||||
(snippet
|
||||
;; We do not provide `ncurses.h' within an `ncursesw'
|
||||
;; sub-directory, so patch the source accordingly. See
|
||||
;; <http://bugs.gnu.org/19018>.
|
||||
'(for-each (lambda (file)
|
||||
(substitute* file
|
||||
(("ncursesw/ncurses.h")
|
||||
"ncurses.h")))
|
||||
(find-files "." "configure$|\\.c$")))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs `(("ncurses" ,ncurses)
|
||||
("perl" ,perl)))
|
||||
(home-page "http://www.gnu.org/software/gtypist/")
|
||||
(synopsis "Typing tutor")
|
||||
(description
|
||||
"GNU Typist is a universal typing tutor. It can be used to learn and
|
||||
practice touch-typing. Several tutorials are included; in addition to
|
||||
tutorials for the standard QWERTY layout, there are also tutorials for the
|
||||
alternative layouts Dvorak and Colemak, as well as for the numpad. Tutorials
|
||||
are primarily in English, however some in other languages are provided.")
|
||||
(license license:gpl3+)))
|
||||
|
||||
(define-public tiled
|
||||
(package
|
||||
(name "tiled")
|
||||
(version "0.10.2")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "https://github.com/bjorn/tiled/archive/v"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0p4p3lv4nw11fkfvvyjirb93r2x4w2rrc2w650gl2k57k92jpiij"))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs `(("qt" ,qt)
|
||||
("zlib" ,zlib)))
|
||||
(arguments
|
||||
'(#:phases
|
||||
(alist-replace
|
||||
'configure
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(let ((out (assoc-ref outputs "out")))
|
||||
(system* "qmake"
|
||||
(string-append "PREFIX=" out))))
|
||||
%standard-phases)))
|
||||
(home-page "http://www.mapeditor.org/")
|
||||
(synopsis "Tile map editor")
|
||||
(description
|
||||
"Tiled is a general purpose tile map editor. It is meant to be used for
|
||||
editing maps of any tile-based game, be it an RPG, a platformer or a Breakout
|
||||
clone.")
|
||||
|
||||
;; As noted in 'COPYING', part of it is under GPLv2+, while the rest is
|
||||
;; under BSD-2.
|
||||
(license license:gpl2+)))
|
||||
|
||||
(define-public openal
|
||||
(package
|
||||
(name "openal")
|
||||
(version "1.15.1")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
"http://kcat.strangesoft.net/openal-releases/openal-soft-"
|
||||
version ".tar.bz2"))
|
||||
(sha256
|
||||
(base32
|
||||
"0mmhdqiyb3c9dzvxspm8h2v8jibhi8pfjxnf6m0wn744y1ia2a8f"))))
|
||||
(build-system cmake-build-system)
|
||||
(arguments
|
||||
`(#:tests? #f)) ; no check target
|
||||
(inputs
|
||||
`(("alsa-lib" ,alsa-lib)
|
||||
("pulseaudio" ,pulseaudio)))
|
||||
(synopsis "3D audio API")
|
||||
(description
|
||||
"OpenAL provides capabilities for playing audio in a virtual 3D
|
||||
environment. Distance attenuation, doppler shift, and directional sound
|
||||
emitters are among the features handled by the API. More advanced effects,
|
||||
including air absorption, occlusion, and environmental reverb, are available
|
||||
through the EFX extension. It also facilitates streaming audio, multi-channel
|
||||
buffers, and audio capture.")
|
||||
(home-page "http://kcat.strangesoft.net/openal.html")
|
||||
(license license:lgpl2.0+)))
|
||||
|
||||
(define-public irrlicht
|
||||
(package
|
||||
(name "irrlicht")
|
||||
(version "1.8.1")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
"mirror://sourceforge/irrlicht/Irrlicht%20SDK/"
|
||||
(version-major+minor version)
|
||||
"/" version "/irrlicht-" version ".zip"))
|
||||
(sha256
|
||||
(base32
|
||||
"0yz9lvsc8aqk8wj4rnpanxrw90gqpwn9w5hxp94r8hnm2q0vjjw1"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
'(#:phases (alist-cons-after
|
||||
'unpack 'fix-build-env
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(let ((out (assoc-ref outputs "out")))
|
||||
(substitute* "Makefile"
|
||||
(("INSTALL_DIR = /usr/local/lib")
|
||||
(string-append "INSTALL_DIR = " out "/lib")))
|
||||
;; The Makefile assumes these directories exist.
|
||||
(mkdir-p (string-append out "/lib"))
|
||||
(mkdir-p (string-append out "/include"))))
|
||||
(alist-replace
|
||||
'unpack
|
||||
(lambda* (#:key source #:allow-other-keys)
|
||||
(and (zero? (system* "unzip" source))
|
||||
;; The actual source is buried a few directories deep.
|
||||
(chdir "irrlicht-1.8.1/source/Irrlicht/")))
|
||||
;; No configure script
|
||||
(alist-delete 'configure %standard-phases)))
|
||||
#:tests? #f ; no check target
|
||||
#:make-flags '("CC=gcc" "sharedlib")))
|
||||
(native-inputs
|
||||
`(("unzip" ,unzip)))
|
||||
(inputs
|
||||
`(("mesa" ,mesa)))
|
||||
(synopsis "3D game engine written in C++")
|
||||
(description
|
||||
"The Irrlicht Engine is a high performance realtime 3D engine written in
|
||||
C++. Features include an OpenGL renderer, extensible materials, scene graph
|
||||
management, character animation, particle and other special effects, support
|
||||
for common mesh file formats, and collision detection.")
|
||||
(home-page "http://irrlicht.sourceforge.net/")
|
||||
(license license:zlib)))
|
||||
|
||||
(define minetest-data
|
||||
(package
|
||||
(name "minetest-data")
|
||||
(version "0.4.10")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
"https://github.com/minetest/minetest_game/archive/"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"09mr71kl7mf4ihszqz1vnwk814p7fvqknad150iic2340a7qzf0i"))))
|
||||
(build-system trivial-build-system)
|
||||
(native-inputs
|
||||
`(("source" ,source)
|
||||
("tar" ,tar)
|
||||
("gzip" ,(@ (gnu packages compression) gzip))))
|
||||
(arguments
|
||||
`(#:modules ((guix build utils))
|
||||
#:builder (begin
|
||||
(use-modules (guix build utils))
|
||||
(let ((tar (string-append (assoc-ref %build-inputs "tar")
|
||||
"/bin/tar"))
|
||||
(install-dir (string-append
|
||||
%output
|
||||
"/share/minetest/games/minetest_game"))
|
||||
(path (string-append (assoc-ref %build-inputs
|
||||
"gzip")
|
||||
"/bin")))
|
||||
(setenv "PATH" path)
|
||||
(system* tar "xvf" (assoc-ref %build-inputs "source"))
|
||||
(chdir (string-append "minetest_game-" ,version))
|
||||
(mkdir-p install-dir)
|
||||
(copy-recursively "." install-dir)))))
|
||||
(synopsis "Main game data for the Minetest game engine")
|
||||
(description
|
||||
"Game data for the Minetest infinite-world block sandox game.")
|
||||
(home-page "http://minetest.net")
|
||||
(license license:lgpl2.1+)))
|
||||
|
||||
(define-public minetest
|
||||
(package
|
||||
(name "minetest")
|
||||
(version "0.4.10")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
"https://github.com/minetest/minetest/archive/"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1xxv0g83iqszjgwnbdcbsprqg76cb6jnbsh5qhm7lcwx4wy2y2k2"))
|
||||
;; This patch will be included in future upstream releases.
|
||||
;; See: https://github.com/minetest/minetest/commit/fd5eaae2babb322f8a3e2acab55a12e218814c8e
|
||||
(patches (list (search-patch "minetest-subgame-env-var.patch")))))
|
||||
(build-system cmake-build-system)
|
||||
(arguments
|
||||
'(#:modules ((guix build utils)
|
||||
(guix build cmake-build-system)
|
||||
(ice-9 match))
|
||||
#:phases (alist-cons-before
|
||||
'configure 'set-cpath
|
||||
(lambda* (#:key inputs #:allow-other-keys)
|
||||
(use-modules (ice-9 match))
|
||||
;; Adjust the CPATH so that cmake can find irrlicht,
|
||||
;; openal, and curl headers.
|
||||
(set-path-environment-variable "CPATH"
|
||||
'("include/AL"
|
||||
"include/irrlicht"
|
||||
"include/curl"
|
||||
"include")
|
||||
(map (match-lambda
|
||||
((_ . dir) dir))
|
||||
inputs)))
|
||||
%standard-phases)
|
||||
#:configure-flags '("-DRUN_IN_PLACE=0"
|
||||
"-DENABLE_FREETYPE=1"
|
||||
"-DENABLE_GETTEXT=1")
|
||||
#:tests? #f)) ; no check target
|
||||
(native-search-paths
|
||||
(list (search-path-specification
|
||||
(variable "MINETEST_SUBGAME_PATH")
|
||||
(directories '("share/minetest/games")))))
|
||||
(native-inputs
|
||||
`(("pkg-config" ,pkg-config)))
|
||||
(inputs
|
||||
`(("irrlicht" ,irrlicht)
|
||||
("libpng" ,libpng)
|
||||
("libjpeg-8" ,libjpeg-8)
|
||||
("libxxf86vm" ,libxxf86vm)
|
||||
("mesa" ,mesa)
|
||||
("libogg" ,libogg)
|
||||
("libvorbis" ,libvorbis)
|
||||
("openal" ,openal)
|
||||
("freetype" ,(@ (gnu packages fontutils) freetype))
|
||||
("curl" ,curl)
|
||||
("luajit" ,luajit)
|
||||
("gettext" ,gnu-gettext)
|
||||
("sqlite" ,sqlite)))
|
||||
(propagated-inputs
|
||||
`(("minetest-data" ,minetest-data)))
|
||||
(synopsis "Infinite-world block sandbox game")
|
||||
(description
|
||||
"Minetest is a sandbox construction game. Players can create and destroy
|
||||
various types of blocks in a three-dimensional open world. This allows
|
||||
forming structures in every possible creation, on multiplayer servers or as a
|
||||
single player. Mods and texture packs allow players to personalize the game
|
||||
in different ways.")
|
||||
(home-page "http://minetest.net")
|
||||
(license license:lgpl2.1+)))
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
@@ -57,15 +57,12 @@
|
||||
(string-append "### " match))))
|
||||
'())
|
||||
|
||||
;; XXX FIXME gawk 4.1.1 was bootstrapped with a prerelease
|
||||
;; libtool, which fails on MIPS in the absence of
|
||||
;; /usr/bin/file. As a temporary workaround, we patch
|
||||
;; the configure script to hardcode use of the little
|
||||
;; endian N32 ABI on MIPS.
|
||||
;; XXX FIXME prerelease libtool fails on MIPS in the
|
||||
;; absence of /usr/bin/file.
|
||||
,@(if (equal? "mips64el-linux" (or (%current-target-system)
|
||||
(%current-system)))
|
||||
'((substitute* "extension/configure"
|
||||
(("\\$emul") "elf32ltsmipn32")))
|
||||
(("/usr/bin/file") (which "file"))))
|
||||
'())))
|
||||
%standard-phases)))
|
||||
(inputs `(("libsigsegv" ,libsigsegv)
|
||||
@@ -75,10 +72,10 @@
|
||||
'())))
|
||||
|
||||
(home-page "http://www.gnu.org/software/gawk/")
|
||||
(synopsis "A text scanning and processing language")
|
||||
(synopsis "Text scanning and processing language")
|
||||
(description
|
||||
"Gawk is the GNU implementation of Awk, a specialized programming
|
||||
language for the easy manipulation of formatted text, such as tables of data.
|
||||
Gawk features many extensions beyond the traditional implementation,
|
||||
Gawk features many extensions beyond the traditional implementation,
|
||||
including network access, sorting, and large libraries.")
|
||||
(license gpl3+)))
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user