diff --git a/TODO b/TODO index 3a8a77b145..3c7ae6ef6c 100644 --- a/TODO +++ b/TODO @@ -4,6 +4,7 @@ #+STARTUP: content hidestars Copyright © 2012, 2013, 2014 Ludovic Courtès +Copyright © 2019 Mathieu Othacehe Copying and distribution of this file, with or without modification, are permitted in any medium without royalty provided the copyright @@ -83,3 +84,38 @@ 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. +* Installer +** Fix impossibility to restart on error after cow-store has been started +See https://lists.gnu.org/archive/html/guix-devel/2018-12/msg00161.html. +- Force reboot upon installer failure +- Unshare the installer process +- Run the installer process in a separate namespace +** Partitioning +*** Add RAID support +*** Add more partitioning schemes +The actual schemes are taken from Debian Installer but some are not +implemented yet: like "Separate partitions for /home /var and /tmp". +*** Replace wait page "Partition formating is in progress, please wait" +Create a new waiting page describing what's being done: + +[ 20% ] +Running mkfs.ext4 on /dev/sda2 ... + +[ 40% ] +Running mkfs.ext4 on /dev/sda3 ... + +** Desktop environments +*** Allow for no desktop environments +Propose to choose between "headless server" and "lightweight X11" in a new +page. +*** Add services selection feature +Add a services page to the configuration. Ask for services to be installed +like SSH, bluetooth, TLP in a checkbox list? +** Locale and keymap +*** Try to guess user locale and keymap by probing BIOS or HW (dmidecode) +** Timezone +*** Regroup everything in one single page +Under the form: +(UTC + 1) Europe/Paris +(UTC + 2) Africa/Cairo +... diff --git a/configure.ac b/configure.ac index 891fce28ae..5d70de4beb 100644 --- a/configure.ac +++ b/configure.ac @@ -135,6 +135,21 @@ if test "x$have_guile_gcrypt" != "xyes"; then AC_MSG_ERROR([Guile-Gcrypt could not be found; please install it.]) fi +dnl Guile-newt is used by the graphical installer. +GUILE_MODULE_AVAILABLE([have_guile_newt], [(newt)]) + +AC_ARG_ENABLE([installer], + AS_HELP_STRING([--enable-installer], [Build the graphical installer sources.])) + +AS_IF([test "x$enable_installer" = "xyes"], [ +if test "x$have_guile_newt" != "xyes"; then + AC_MSG_ERROR([Guile-newt could not be found; please install it.]) +fi +]) + +AM_CONDITIONAL([ENABLE_INSTALLER], + [test "x$enable_installer" = "xyes"]) + dnl Make sure we have a full-fledged Guile. GUIX_ASSERT_GUILE_FEATURES([regex posix socket net-db threads]) diff --git a/doc/guix.texi b/doc/guix.texi index 34d0bf32fa..d6148757fe 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -9328,12 +9328,20 @@ GuixSD in a virtual machine (VM). @subsection Preparing for Installation Once you have successfully booted your computer using the installation medium, -you should end up with a root prompt. Several console TTYs are configured -and can be used to run commands as root. TTY2 shows this documentation, -browsable using the Info reader commands (@pxref{Top,,, info-stnd, -Stand-alone GNU Info}). The installation system runs the GPM mouse -daemon, which allows you to select text with the left mouse button and -to paste it with the middle button. +you should end up with the welcome page of the graphical installer. The +graphical installer is a text-based user interface built upon the newt +library. It shall guide you through all the different steps needed to install +GNU GuixSD. However, as the graphical installer is still under heavy +development, you might want to fallback to the original, shell based install +process, by switching to TTYs 3 to 6 with the shortcuts CTRL-ALT-F[3-6]. The +following sections describe the installation procedure assuming you're using +one of those TTYs. They are configured and can be used to run commands as +root. + +TTY2 shows this documentation, browsable using the Info reader commands +(@pxref{Top,,, info-stnd, Stand-alone GNU Info}). The installation system +runs the GPM mouse daemon, which allows you to select text with the left mouse +button and to paste it with the middle button. @quotation Note Installation requires access to the Internet so that any missing @@ -9660,12 +9668,12 @@ unless your configuration specifies otherwise (@pxref{user-account-password, user account passwords}). @cindex upgrading GuixSD -From then on, you can update GuixSD whenever you want by running -@command{guix pull} as @code{root} (@pxref{Invoking guix pull}), and -then running @command{guix system reconfigure} to build a new system -generation with the latest packages and services (@pxref{Invoking guix -system}). We recommend doing that regularly so that your system -includes the latest security updates (@pxref{Security Updates}). +From then on, you can update GuixSD whenever you want by running @command{guix +pull} as @code{root} (@pxref{Invoking guix pull}), and then running +@command{guix system reconfigure /etc/config.scm}, as @code{root} too, to +build a new system generation with the latest packages and services +(@pxref{Invoking guix system}). We recommend doing that regularly so that +your system includes the latest security updates (@pxref{Security Updates}). Join us on @code{#guix} on the Freenode IRC network or on @email{guix-devel@@gnu.org} to share your experience---good or not so @@ -10848,7 +10856,9 @@ system, you will want to append services to @var{%base-services}, like this: @example -(cons* (avahi-service) (lsh-service) %base-services) +(cons* (service avahi-service-type) + (service openssh-service-type) + %base-services) @end example @end defvr @@ -12634,6 +12644,19 @@ This is a symbol specifying the logging level: @code{quiet}, @code{fatal}, @code{error}, @code{info}, @code{verbose}, @code{debug}, etc. See the man page for @file{sshd_config} for the full list of level names. +@item @code{extra-content} (default: @code{""}) +This field can be used to append arbitrary text to the configuration file. It +is especially useful for elaborate configurations that cannot be expressed +otherwise. This configuration, for example, would generally disable root +logins, but permit them from one specific IP address: + +@example +(openssh-configuration + (extra-content "\ +Match Address 192.168.0.1 + PermitRootLogin yes")) +@end example + @end table @end deftp @@ -12709,31 +12732,54 @@ browsers, from accessing Facebook. The @code{(gnu services avahi)} provides the following definition. -@deffn {Scheme Procedure} avahi-service [#:avahi @var{avahi}] @ - [#:host-name #f] [#:publish? #t] [#:ipv4? #t] @ - [#:ipv6? #t] [#:wide-area? #f] @ - [#:domains-to-browse '()] [#:debug? #f] -Return a service that runs @command{avahi-daemon}, a system-wide +@defvr {Scheme Variable} avahi-service-type +This is the service that runs @command{avahi-daemon}, a system-wide mDNS/DNS-SD responder that allows for service discovery and -"zero-configuration" host name lookups (see @uref{http://avahi.org/}), and -extends the name service cache daemon (nscd) so that it can resolve -@code{.local} host names using -@uref{http://0pointer.de/lennart/projects/nss-mdns/, nss-mdns}. Additionally, -add the @var{avahi} package to the system profile so that commands such as -@command{avahi-browse} are directly usable. +``zero-configuration'' host name lookups (see @uref{http://avahi.org/}). +Its value must be a @code{zero-configuration} record---see below. -If @var{host-name} is different from @code{#f}, use that as the host name to +This service extends the name service cache daemon (nscd) so that it can +resolve @code{.local} host names using +@uref{http://0pointer.de/lennart/projects/nss-mdns/, nss-mdns}. @xref{Name +Service Switch}, for information on host name resolution. + +Additionally, add the @var{avahi} package to the system profile so that +commands such as @command{avahi-browse} are directly usable. +@end defvr + +@deftp {Data Type} avahi-configuration +Data type representation the configuration for Avahi. + +@table @asis + +@item @code{host-name} (default: @code{#f}) +If different from @code{#f}, use that as the host name to publish for this machine; otherwise, use the machine's actual host name. -When @var{publish?} is true, publishing of host names and services is allowed; -in particular, avahi-daemon will publish the machine's host name and IP -address via mDNS on the local network. +@item @code{publish?} (default: @code{#t}) +When true, allow host names and services to be published (broadcast) over the +network. -When @var{wide-area?} is true, DNS-SD over unicast DNS is enabled. +@item @code{publish-workstation?} (default: @code{#t}) +When true, @command{avahi-daemon} publishes the machine's host name and IP +address via mDNS on the local network. To view the host names published on +your local network, you can run: -Boolean values @var{ipv4?} and @var{ipv6?} determine whether to use IPv4/IPv6 -sockets. -@end deffn +@example +avahi-browse _workstation._tcp +@end example + +@item @code{wide-area?} (default: @code{#f}) +When true, DNS-SD over unicast DNS is enabled. + +@item @code{ipv4?} (default: @code{#t}) +@itemx @code{ipv6?} (default: @code{#t}) +These fields determine whether to use IPv4/IPv6 sockets. + +@item @code{domains-to-browse} (default: @code{'()}) +This is a list of domains to browse. +@end table +@end deftp @deffn {Scheme Variable} openvswitch-service-type This is the type of the @uref{http://www.openvswitch.org, Open vSwitch} @@ -22339,8 +22385,8 @@ want is to have @code{.local} host lookup working. Note that, in this case, in addition to setting the @code{name-service-switch} of the @code{operating-system} declaration, -you also need to use @code{avahi-service} (@pxref{Networking Services, -@code{avahi-service}}), or @var{%desktop-services}, which includes it +you also need to use @code{avahi-service-type} (@pxref{Networking Services, +@code{avahi-service-type}}), or @var{%desktop-services}, which includes it (@pxref{Desktop Services}). Doing this makes @code{nss-mdns} accessible to the name service cache daemon (@pxref{Base Services, @code{nscd-service}}). diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm index 4f2c71cb5a..a32bf5ec67 100644 --- a/gnu/bootloader.scm +++ b/gnu/bootloader.scm @@ -105,9 +105,7 @@ (define-record-type* bootloader-configuration make-bootloader-configuration bootloader-configuration? (bootloader bootloader-configuration-bootloader) ; - (device bootloader-configuration-device ; string - (default #f)) - (target %bootloader-configuration-target ; string + (target bootloader-configuration-target ; string (default #f)) (menu-entries bootloader-configuration-menu-entries ; list of (default '())) @@ -128,15 +126,6 @@ (define-record-type* (additional-configuration bootloader-configuration-additional-configuration ; record (default #f))) -(define (bootloader-configuration-target config) - (or (%bootloader-configuration-target config) - (let ((device (bootloader-configuration-device config))) - (when device - (warning - (G_ "The 'device' field of bootloader configurations is deprecated.~%")) - (warning (G_ "Use 'target' instead.~%"))) - device))) - ;;; ;;; Bootloaders. diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm index e3369d8521..c468144170 100644 --- a/gnu/build/file-systems.scm +++ b/gnu/build/file-systems.scm @@ -42,6 +42,10 @@ (define-module (gnu build file-systems) find-partition-by-luks-uuid canonicalize-device-spec + read-partition-label + read-partition-uuid + read-luks-partition-uuid + bind-mount mount-flags->bit-mask @@ -435,6 +439,12 @@ (define read-partition-label (define read-partition-uuid (cut read-partition-field <> %partition-uuid-readers)) +(define luks-partition-field-reader + (partition-field-reader read-luks-header luks-header-uuid)) + +(define read-luks-partition-uuid + (cut read-partition-field <> (list luks-partition-field-reader))) + (define (partition-predicate reader =) "Return a predicate that returns true if the FIELD of partition header that was READ is = to the given value." @@ -451,9 +461,7 @@ (define partition-uuid-predicate (partition-predicate read-partition-uuid uuid=?)) (define luks-partition-uuid-predicate - (partition-predicate - (partition-field-reader read-luks-header luks-header-uuid) - uuid=?)) + (partition-predicate luks-partition-field-reader uuid=?)) (define (find-partition predicate) "Return the first partition found that matches PREDICATE, or #f if none diff --git a/gnu/ci.scm b/gnu/ci.scm index c071f21e0a..943fbb6af6 100644 --- a/gnu/ci.scm +++ b/gnu/ci.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2017 Jan Nieuwenhuizen ;;; Copyright © 2018 Clément Lassieur ;;; @@ -24,7 +24,9 @@ (define-module (gnu ci) #:use-module (guix grafts) #:use-module (guix profiles) #:use-module (guix packages) + #:use-module (guix channels) #:use-module (guix derivations) + #:use-module (guix build-system) #:use-module (guix monads) #:use-module (guix ui) #:use-module ((guix licenses) @@ -188,8 +190,40 @@ (define MiB "iso9660")))))) '())) -(define (system-test-jobs store system) +(define channel-build-system + ;; Build system used to "convert" a channel instance to a package. + (let* ((build (lambda* (store name inputs + #:key instance #:allow-other-keys) + (run-with-store store + (channel-instances->derivation (list instance))))) + (lower (lambda* (name #:key system instance #:allow-other-keys) + (bag + (name name) + (system system) + (build build) + (arguments `(#:instance ,instance)))))) + (build-system (name 'channel) + (description "Turn a channel instance into a package.") + (lower lower)))) + +(define (channel-instance->package instance) + "Return a package for the given channel INSTANCE." + (package + (inherit guix) + (version (or (string-take (channel-instance-commit instance) 7) + (string-append (package-version guix) "+"))) + (build-system channel-build-system) + (arguments `(#:instance ,instance)) + (inputs '()) + (native-inputs '()) + (propagated-inputs '()))) + +(define* (system-test-jobs store system + #:key source commit) "Return a list of jobs for the system tests." + (define instance + (checkout->channel-instance source #:commit commit)) + (define (test->thunk test) (lambda () (define drv @@ -217,7 +251,13 @@ (define (->job test) (cons name (test->thunk test)))) (if (member system %guixsd-supported-systems) - (map ->job (all-system-tests)) + ;; Override the value of 'current-guix' used by system tests. Using a + ;; channel instance makes tests that rely on 'current-guix' less + ;; expensive. It also makes sure we get a valid Guix package when this + ;; code is not running from a checkout. + (parameterize ((current-guix-package + (channel-instance->package instance))) + (map ->job (all-system-tests))) '())) (define (tarball-jobs store system) @@ -343,6 +383,21 @@ (define systems ((lst ...) lst) ((? string? str) (call-with-input-string str read)))) + (define checkout + ;; Extract metadata about the 'guix' checkout. Its key in ARGUMENTS may + ;; vary, so pick up the first one that's neither 'subset' nor 'systems'. + (any (match-lambda + ((key . value) + (and (not (memq key '(systems subset))) + value))) + arguments)) + + (define commit + (assq-ref checkout 'revision)) + + (define source + (assq-ref checkout 'file-name)) + (define (cross-jobs system) (define (from-32-to-64? target) ;; Return true if SYSTEM is 32-bit and TARGET is 64-bit. This hack @@ -405,7 +460,9 @@ (define (either proc1 proc2 proc3) system)))) (append (filter-map job all) (qemu-jobs store system) - (system-test-jobs store system) + (system-test-jobs store system + #:source source + #:commit commit) (tarball-jobs store system) (cross-jobs system)))) ((core) diff --git a/gnu/installer.scm b/gnu/installer.scm new file mode 100644 index 0000000000..2ae139b13f --- /dev/null +++ b/gnu/installer.scm @@ -0,0 +1,358 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Mathieu Othacehe +;;; +;;; 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 . + +(define-module (gnu installer) + #:use-module (guix discovery) + #:use-module (guix packages) + #:use-module (guix gexp) + #:use-module (guix modules) + #:use-module (guix utils) + #:use-module (guix ui) + #:use-module ((guix self) #:select (make-config.scm)) + #:use-module (gnu packages admin) + #:use-module (gnu packages base) + #:use-module (gnu packages bash) + #:use-module (gnu packages connman) + #:use-module (gnu packages cryptsetup) + #:use-module (gnu packages disk) + #:use-module (gnu packages guile) + #:autoload (gnu packages gnupg) (guile-gcrypt) + #:use-module (gnu packages iso-codes) + #:use-module (gnu packages linux) + #:use-module (gnu packages ncurses) + #:use-module (gnu packages package-management) + #:use-module (gnu packages xorg) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:export (installer-program)) + +(define not-config? + ;; Select (guix …) and (gnu …) modules, except (guix config). + (match-lambda + (('guix 'config) #f) + (('guix rest ...) #t) + (('gnu rest ...) #t) + (rest #f))) + +(define* (build-compiled-file name locale-builder) + "Return a file-like object that evalutes the gexp LOCALE-BUILDER and store +its result in the scheme file NAME. The derivation will also build a compiled +version of this file." + (define set-utf8-locale + #~(begin + (setenv "LOCPATH" + #$(file-append glibc-utf8-locales "/lib/locale/" + (version-major+minor + (package-version glibc-utf8-locales)))) + (setlocale LC_ALL "en_US.utf8"))) + + (define builder + (with-extensions (list guile-json) + (with-imported-modules (source-module-closure + '((gnu installer locale))) + #~(begin + (use-modules (gnu installer locale)) + + ;; The locale files contain non-ASCII characters. + #$set-utf8-locale + + (mkdir #$output) + (let ((locale-file + (string-append #$output "/" #$name ".scm")) + (locale-compiled-file + (string-append #$output "/" #$name ".go"))) + (call-with-output-file locale-file + (lambda (port) + (write #$locale-builder port))) + (compile-file locale-file + #:output-file locale-compiled-file)))))) + (computed-file name builder)) + +(define apply-locale + ;; Install the specified locale. + #~(lambda (locale-name) + (false-if-exception + (setlocale LC_ALL locale-name)))) + +(define* (compute-locale-step #:key + locales-name + iso639-languages-name + iso3166-territories-name) + "Return a gexp that run the locale-page of INSTALLER, and install the +selected locale. The list of locales, languages and territories passed to +locale-page are computed in derivations named respectively LOCALES-NAME, +ISO639-LANGUAGES-NAME and ISO3166-TERRITORIES-NAME. Those lists are compiled, +so that when the installer is run, all the lengthy operations have already +been performed at build time." + (define (compiled-file-loader file name) + #~(load-compiled + (string-append #$file "/" #$name ".go"))) + + (let* ((supported-locales #~(supported-locales->locales + #$(local-file "installer/aux-files/SUPPORTED"))) + (iso-codes #~(string-append #$iso-codes "/share/iso-codes/json/")) + (iso639-3 #~(string-append #$iso-codes "iso_639-3.json")) + (iso639-5 #~(string-append #$iso-codes "iso_639-5.json")) + (iso3166 #~(string-append #$iso-codes "iso_3166-1.json")) + (locales-file (build-compiled-file + locales-name + #~`(quote ,#$supported-locales))) + (iso639-file (build-compiled-file + iso639-languages-name + #~`(quote ,(iso639->iso639-languages + #$supported-locales + #$iso639-3 #$iso639-5)))) + (iso3166-file (build-compiled-file + iso3166-territories-name + #~`(quote ,(iso3166->iso3166-territories #$iso3166)))) + (locales-loader (compiled-file-loader locales-file + locales-name)) + (iso639-loader (compiled-file-loader iso639-file + iso639-languages-name)) + (iso3166-loader (compiled-file-loader iso3166-file + iso3166-territories-name))) + #~(lambda (current-installer) + (let ((result + ((installer-locale-page current-installer) + #:supported-locales #$locales-loader + #:iso639-languages #$iso639-loader + #:iso3166-territories #$iso3166-loader))) + (#$apply-locale result) + result)))) + +(define apply-keymap + ;; Apply the specified keymap. Use the default keyboard model. + #~(match-lambda + ((layout variant) + (kmscon-update-keymap (default-keyboard-model) + layout variant)))) + +(define* (compute-keymap-step) + "Return a gexp that runs the keymap-page of INSTALLER and install the +selected keymap." + #~(lambda (current-installer) + (let ((result + (call-with-values + (lambda () + (xkb-rules->models+layouts + (string-append #$xkeyboard-config + "/share/X11/xkb/rules/base.xml"))) + (lambda (models layouts) + ((installer-keymap-page current-installer) + layouts))))) + (#$apply-keymap result)))) + +(define (installer-steps) + (let ((locale-step (compute-locale-step + #:locales-name "locales" + #:iso639-languages-name "iso639-languages" + #:iso3166-territories-name "iso3166-territories")) + (keymap-step (compute-keymap-step)) + (timezone-data #~(string-append #$tzdata + "/share/zoneinfo/zone.tab"))) + #~(lambda (current-installer) + (list + ;; Welcome the user and ask him to choose between manual + ;; installation and graphical install. + (installer-step + (id 'welcome) + (compute (lambda _ + ((installer-welcome-page current-installer) + #$(local-file "installer/aux-files/logo.txt"))))) + + ;; Ask the user to choose a locale among those supported by + ;; the glibc. Install the selected locale right away, so that + ;; the user may benefit from any available translation for the + ;; installer messages. + (installer-step + (id 'locale) + (description (G_ "Locale")) + (compute (lambda _ + (#$locale-step current-installer))) + (configuration-formatter locale->configuration)) + + ;; Ask the user to select a timezone under glibc format. + (installer-step + (id 'timezone) + (description (G_ "Timezone")) + (compute (lambda _ + ((installer-timezone-page current-installer) + #$timezone-data))) + (configuration-formatter posix-tz->configuration)) + + ;; The installer runs in a kmscon virtual terminal where loadkeys + ;; won't work. kmscon uses libxkbcommon as a backend for keyboard + ;; input. It is possible to update kmscon current keymap by sending it + ;; a keyboard model, layout and variant, in a somehow similar way as + ;; what is done with setxkbmap utility. + ;; + ;; So ask for a keyboard model, layout and variant to update the + ;; current kmscon keymap. + (installer-step + (id 'keymap) + (description (G_ "Keyboard mapping selection")) + (compute (lambda _ + (#$keymap-step current-installer)))) + + ;; Run a partitioning tool allowing the user to modify + ;; partition tables, partitions and their mount points. + (installer-step + (id 'partition) + (description (G_ "Partitioning")) + (compute (lambda _ + ((installer-partition-page current-installer)))) + (configuration-formatter user-partitions->configuration)) + + ;; Ask the user to input a hostname for the system. + (installer-step + (id 'hostname) + (description (G_ "Hostname")) + (compute (lambda _ + ((installer-hostname-page current-installer)))) + (configuration-formatter hostname->configuration)) + + ;; Provide an interface above connmanctl, so that the user can select + ;; a network susceptible to acces Internet. + (installer-step + (id 'network) + (description (G_ "Network selection")) + (compute (lambda _ + ((installer-network-page current-installer))))) + + ;; Prompt for users (name, group and home directory). + (installer-step + (id 'user) + (description (G_ "User creation")) + (compute (lambda _ + ((installer-user-page current-installer)))) + (configuration-formatter users->configuration)) + + ;; Ask the user to choose one or many desktop environment(s). + (installer-step + (id 'services) + (description (G_ "Services")) + (compute (lambda _ + ((installer-services-page current-installer)))) + (configuration-formatter + desktop-environments->configuration)) + + (installer-step + (id 'final) + (description (G_ "Configuration file")) + (compute + (lambda (result prev-steps) + ((installer-final-page current-installer) + result prev-steps)))))))) + +(define (installer-program) + "Return a file-like object that runs the given INSTALLER." + (define init-gettext + ;; Initialize gettext support, so that installer messages can be + ;; translated. + #~(begin + (bindtextdomain "guix" (string-append #$guix "/share/locale")) + (textdomain "guix"))) + + (define set-installer-path + ;; Add the specified binary to PATH for later use by the installer. + #~(let* ((inputs + '#$(append (list bash ;start subshells + connman ;call connmanctl + cryptsetup + dosfstools ;mkfs.fat + e2fsprogs ;mkfs.ext4 + kbd ;chvt + guix ;guix system init call + util-linux ;mkwap + shadow) + (map canonical-package (list coreutils))))) + (with-output-to-port (%make-void-port "w") + (lambda () + (set-path-environment-variable "PATH" '("bin" "sbin") inputs))))) + + (define steps (installer-steps)) + (define modules + (scheme-modules* + (string-append (current-source-directory) "/..") + "gnu/installer")) + + (define installer-builder + (with-extensions (list guile-gcrypt guile-newt + guile-parted guile-bytestructures + guile-json) + (with-imported-modules `(,@(source-module-closure + `(,@modules + (guix build utils)) + #:select? not-config?) + ((guix config) => ,(make-config.scm))) + #~(begin + (use-modules (gnu installer record) + (gnu installer keymap) + (gnu installer steps) + (gnu installer final) + (gnu installer hostname) + (gnu installer locale) + (gnu installer parted) + (gnu installer services) + (gnu installer timezone) + (gnu installer user) + (gnu installer newt) + (guix i18n) + (guix build utils) + (ice-9 match)) + + ;; Initialize gettext support so that installers can use + ;; (guix i18n) module. + #$init-gettext + + ;; Add some binaries used by the installers to PATH. + #$set-installer-path + + (let* ((current-installer newt-installer) + (steps (#$steps current-installer))) + ((installer-init current-installer)) + + (catch #t + (lambda () + (run-installer-steps + #:rewind-strategy 'menu + #:menu-proc (installer-menu-page current-installer) + #:steps steps)) + (const #f) + (lambda (key . args) + (let ((error-file "/tmp/last-installer-error")) + (call-with-output-file error-file + (lambda (port) + (display-backtrace (make-stack #t) port) + (print-exception port + (stack-ref (make-stack #t) 1) + key args))) + ((installer-exit-error current-installer) + error-file key args)) + (primitive-exit 1))) + + ((installer-exit current-installer))))))) + + (program-file + "installer" + #~(begin + ;; Set the default locale to install unicode support. For + ;; some reason, unicode support is not correctly installed + ;; when calling this in 'installer-builder'. + (setenv "LANG" "en_US.UTF-8") + (system #$(program-file "installer-real" installer-builder))))) diff --git a/gnu/installer/aux-files/SUPPORTED b/gnu/installer/aux-files/SUPPORTED new file mode 100644 index 0000000000..24aae1e089 --- /dev/null +++ b/gnu/installer/aux-files/SUPPORTED @@ -0,0 +1,484 @@ +aa_DJ.UTF-8 UTF-8 +aa_DJ ISO-8859-1 +aa_ER UTF-8 +aa_ER@saaho UTF-8 +aa_ET UTF-8 +af_ZA.UTF-8 UTF-8 +af_ZA ISO-8859-1 +agr_PE UTF-8 +ak_GH UTF-8 +am_ET UTF-8 +an_ES.UTF-8 UTF-8 +an_ES ISO-8859-15 +anp_IN UTF-8 +ar_AE.UTF-8 UTF-8 +ar_AE ISO-8859-6 +ar_BH.UTF-8 UTF-8 +ar_BH ISO-8859-6 +ar_DZ.UTF-8 UTF-8 +ar_DZ ISO-8859-6 +ar_EG.UTF-8 UTF-8 +ar_EG ISO-8859-6 +ar_IN UTF-8 +ar_IQ.UTF-8 UTF-8 +ar_IQ ISO-8859-6 +ar_JO.UTF-8 UTF-8 +ar_JO ISO-8859-6 +ar_KW.UTF-8 UTF-8 +ar_KW ISO-8859-6 +ar_LB.UTF-8 UTF-8 +ar_LB ISO-8859-6 +ar_LY.UTF-8 UTF-8 +ar_LY ISO-8859-6 +ar_MA.UTF-8 UTF-8 +ar_MA ISO-8859-6 +ar_OM.UTF-8 UTF-8 +ar_OM ISO-8859-6 +ar_QA.UTF-8 UTF-8 +ar_QA ISO-8859-6 +ar_SA.UTF-8 UTF-8 +ar_SA ISO-8859-6 +ar_SD.UTF-8 UTF-8 +ar_SD ISO-8859-6 +ar_SS UTF-8 +ar_SY.UTF-8 UTF-8 +ar_SY ISO-8859-6 +ar_TN.UTF-8 UTF-8 +ar_TN ISO-8859-6 +ar_YE.UTF-8 UTF-8 +ar_YE ISO-8859-6 +ayc_PE UTF-8 +az_AZ UTF-8 +az_IR UTF-8 +as_IN UTF-8 +ast_ES.UTF-8 UTF-8 +ast_ES ISO-8859-15 +be_BY.UTF-8 UTF-8 +be_BY CP1251 +be_BY@latin UTF-8 +bem_ZM UTF-8 +ber_DZ UTF-8 +ber_MA UTF-8 +bg_BG.UTF-8 UTF-8 +bg_BG CP1251 +bhb_IN.UTF-8 UTF-8 +bho_IN UTF-8 +bho_NP UTF-8 +bi_VU UTF-8 +bn_BD UTF-8 +bn_IN UTF-8 +bo_CN UTF-8 +bo_IN UTF-8 +br_FR.UTF-8 UTF-8 +br_FR ISO-8859-1 +br_FR@euro ISO-8859-15 +brx_IN UTF-8 +bs_BA.UTF-8 UTF-8 +bs_BA ISO-8859-2 +byn_ER UTF-8 +ca_AD.UTF-8 UTF-8 +ca_AD ISO-8859-15 +ca_ES.UTF-8 UTF-8 +ca_ES ISO-8859-1 +ca_ES@euro ISO-8859-15 +ca_ES@valencia UTF-8 +ca_FR.UTF-8 UTF-8 +ca_FR ISO-8859-15 +ca_IT.UTF-8 UTF-8 +ca_IT ISO-8859-15 +ce_RU UTF-8 +chr_US UTF-8 +cmn_TW UTF-8 +crh_UA UTF-8 +cs_CZ.UTF-8 UTF-8 +cs_CZ ISO-8859-2 +csb_PL UTF-8 +cv_RU UTF-8 +cy_GB.UTF-8 UTF-8 +cy_GB ISO-8859-14 +da_DK.UTF-8 UTF-8 +da_DK ISO-8859-1 +de_AT.UTF-8 UTF-8 +de_AT ISO-8859-1 +de_AT@euro ISO-8859-15 +de_BE.UTF-8 UTF-8 +de_BE ISO-8859-1 +de_BE@euro ISO-8859-15 +de_CH.UTF-8 UTF-8 +de_CH ISO-8859-1 +de_DE.UTF-8 UTF-8 +de_DE ISO-8859-1 +de_DE@euro ISO-8859-15 +de_IT.UTF-8 UTF-8 +de_IT ISO-8859-1 +de_LI.UTF-8 UTF-8 +de_LU.UTF-8 UTF-8 +de_LU ISO-8859-1 +de_LU@euro ISO-8859-15 +doi_IN UTF-8 +dv_MV UTF-8 +dz_BT UTF-8 +el_GR.UTF-8 UTF-8 +el_GR ISO-8859-7 +el_GR@euro ISO-8859-7 +el_CY.UTF-8 UTF-8 +el_CY ISO-8859-7 +en_AG UTF-8 +en_AU.UTF-8 UTF-8 +en_AU ISO-8859-1 +en_BW.UTF-8 UTF-8 +en_BW ISO-8859-1 +en_CA.UTF-8 UTF-8 +en_CA ISO-8859-1 +en_DK.UTF-8 UTF-8 +en_DK ISO-8859-1 +en_GB.UTF-8 UTF-8 +en_GB ISO-8859-1 +en_HK.UTF-8 UTF-8 +en_HK ISO-8859-1 +en_IE.UTF-8 UTF-8 +en_IE ISO-8859-1 +en_IE@euro ISO-8859-15 +en_IL UTF-8 +en_IN UTF-8 +en_NG UTF-8 +en_NZ.UTF-8 UTF-8 +en_NZ ISO-8859-1 +en_PH.UTF-8 UTF-8 +en_PH ISO-8859-1 +en_SC.UTF-8 UTF-8 +en_SG.UTF-8 UTF-8 +en_SG ISO-8859-1 +en_US.UTF-8 UTF-8 +en_US ISO-8859-1 +en_ZA.UTF-8 UTF-8 +en_ZA ISO-8859-1 +en_ZM UTF-8 +en_ZW.UTF-8 UTF-8 +en_ZW ISO-8859-1 +eo UTF-8 +es_AR.UTF-8 UTF-8 +es_AR ISO-8859-1 +es_BO.UTF-8 UTF-8 +es_BO ISO-8859-1 +es_CL.UTF-8 UTF-8 +es_CL ISO-8859-1 +es_CO.UTF-8 UTF-8 +es_CO ISO-8859-1 +es_CR.UTF-8 UTF-8 +es_CR ISO-8859-1 +es_CU UTF-8 +es_DO.UTF-8 UTF-8 +es_DO ISO-8859-1 +es_EC.UTF-8 UTF-8 +es_EC ISO-8859-1 +es_ES.UTF-8 UTF-8 +es_ES ISO-8859-1 +es_ES@euro ISO-8859-15 +es_GT.UTF-8 UTF-8 +es_GT ISO-8859-1 +es_HN.UTF-8 UTF-8 +es_HN ISO-8859-1 +es_MX.UTF-8 UTF-8 +es_MX ISO-8859-1 +es_NI.UTF-8 UTF-8 +es_NI ISO-8859-1 +es_PA.UTF-8 UTF-8 +es_PA ISO-8859-1 +es_PE.UTF-8 UTF-8 +es_PE ISO-8859-1 +es_PR.UTF-8 UTF-8 +es_PR ISO-8859-1 +es_PY.UTF-8 UTF-8 +es_PY ISO-8859-1 +es_SV.UTF-8 UTF-8 +es_SV ISO-8859-1 +es_US.UTF-8 UTF-8 +es_US ISO-8859-1 +es_UY.UTF-8 UTF-8 +es_UY ISO-8859-1 +es_VE.UTF-8 UTF-8 +es_VE ISO-8859-1 +et_EE.UTF-8 UTF-8 +et_EE ISO-8859-1 +et_EE.ISO-8859-15 ISO-8859-15 +eu_ES.UTF-8 UTF-8 +eu_ES ISO-8859-1 +eu_ES@euro ISO-8859-15 +fa_IR UTF-8 +ff_SN UTF-8 +fi_FI.UTF-8 UTF-8 +fi_FI ISO-8859-1 +fi_FI@euro ISO-8859-15 +fil_PH UTF-8 +fo_FO.UTF-8 UTF-8 +fo_FO ISO-8859-1 +fr_BE.UTF-8 UTF-8 +fr_BE ISO-8859-1 +fr_BE@euro ISO-8859-15 +fr_CA.UTF-8 UTF-8 +fr_CA ISO-8859-1 +fr_CH.UTF-8 UTF-8 +fr_CH ISO-8859-1 +fr_FR.UTF-8 UTF-8 +fr_FR ISO-8859-1 +fr_FR@euro ISO-8859-15 +fr_LU.UTF-8 UTF-8 +fr_LU ISO-8859-1 +fr_LU@euro ISO-8859-15 +fur_IT UTF-8 +fy_NL UTF-8 +fy_DE UTF-8 +ga_IE.UTF-8 UTF-8 +ga_IE ISO-8859-1 +ga_IE@euro ISO-8859-15 +gd_GB.UTF-8 UTF-8 +gd_GB ISO-8859-15 +gez_ER UTF-8 +gez_ER@abegede UTF-8 +gez_ET UTF-8 +gez_ET@abegede UTF-8 +gl_ES.UTF-8 UTF-8 +gl_ES ISO-8859-1 +gl_ES@euro ISO-8859-15 +gu_IN UTF-8 +gv_GB.UTF-8 UTF-8 +gv_GB ISO-8859-1 +ha_NG UTF-8 +hak_TW UTF-8 +he_IL.UTF-8 UTF-8 +he_IL ISO-8859-8 +hi_IN UTF-8 +hif_FJ UTF-8 +hne_IN UTF-8 +hr_HR.UTF-8 UTF-8 +hr_HR ISO-8859-2 +hsb_DE ISO-8859-2 +hsb_DE.UTF-8 UTF-8 +ht_HT UTF-8 +hu_HU.UTF-8 UTF-8 +hu_HU ISO-8859-2 +hy_AM UTF-8 +hy_AM.ARMSCII-8 ARMSCII-8 +ia_FR UTF-8 +id_ID.UTF-8 UTF-8 +id_ID ISO-8859-1 +ig_NG UTF-8 +ik_CA UTF-8 +is_IS.UTF-8 UTF-8 +is_IS ISO-8859-1 +it_CH.UTF-8 UTF-8 +it_CH ISO-8859-1 +it_IT.UTF-8 UTF-8 +it_IT ISO-8859-1 +it_IT@euro ISO-8859-15 +iu_CA UTF-8 +ja_JP.EUC-JP EUC-JP +ja_JP.UTF-8 UTF-8 +ka_GE.UTF-8 UTF-8 +ka_GE GEORGIAN-PS +kab_DZ UTF-8 +kk_KZ.UTF-8 UTF-8 +kk_KZ PT154 +kl_GL.UTF-8 UTF-8 +kl_GL ISO-8859-1 +km_KH UTF-8 +kn_IN UTF-8 +ko_KR.EUC-KR EUC-KR +ko_KR.UTF-8 UTF-8 +kok_IN UTF-8 +ks_IN UTF-8 +ks_IN@devanagari UTF-8 +ku_TR.UTF-8 UTF-8 +ku_TR ISO-8859-9 +kw_GB.UTF-8 UTF-8 +kw_GB ISO-8859-1 +ky_KG UTF-8 +lb_LU UTF-8 +lg_UG.UTF-8 UTF-8 +lg_UG ISO-8859-10 +li_BE UTF-8 +li_NL UTF-8 +lij_IT UTF-8 +ln_CD UTF-8 +lo_LA UTF-8 +lt_LT.UTF-8 UTF-8 +lt_LT ISO-8859-13 +lv_LV.UTF-8 UTF-8 +lv_LV ISO-8859-13 +lzh_TW UTF-8 +mag_IN UTF-8 +mai_IN UTF-8 +mai_NP UTF-8 +mfe_MU UTF-8 +mg_MG.UTF-8 UTF-8 +mg_MG ISO-8859-15 +mhr_RU UTF-8 +mi_NZ.UTF-8 UTF-8 +mi_NZ ISO-8859-13 +miq_NI UTF-8 +mjw_IN UTF-8 +mk_MK.UTF-8 UTF-8 +mk_MK ISO-8859-5 +ml_IN UTF-8 +mn_MN UTF-8 +mni_IN UTF-8 +mr_IN UTF-8 +ms_MY.UTF-8 UTF-8 +ms_MY ISO-8859-1 +mt_MT.UTF-8 UTF-8 +mt_MT ISO-8859-3 +my_MM UTF-8 +nan_TW UTF-8 +nan_TW@latin UTF-8 +nb_NO.UTF-8 UTF-8 +nb_NO ISO-8859-1 +nds_DE UTF-8 +nds_NL UTF-8 +ne_NP UTF-8 +nhn_MX UTF-8 +niu_NU UTF-8 +niu_NZ UTF-8 +nl_AW UTF-8 +nl_BE.UTF-8 UTF-8 +nl_BE ISO-8859-1 +nl_BE@euro ISO-8859-15 +nl_NL.UTF-8 UTF-8 +nl_NL ISO-8859-1 +nl_NL@euro ISO-8859-15 +nn_NO.UTF-8 UTF-8 +nn_NO ISO-8859-1 +nr_ZA UTF-8 +nso_ZA UTF-8 +oc_FR.UTF-8 UTF-8 +oc_FR ISO-8859-1 +om_ET UTF-8 +om_KE.UTF-8 UTF-8 +om_KE ISO-8859-1 +or_IN UTF-8 +os_RU UTF-8 +pa_IN UTF-8 +pa_PK UTF-8 +pap_AW UTF-8 +pap_CW UTF-8 +pl_PL.UTF-8 UTF-8 +pl_PL ISO-8859-2 +ps_AF UTF-8 +pt_BR.UTF-8 UTF-8 +pt_BR ISO-8859-1 +pt_PT.UTF-8 UTF-8 +pt_PT ISO-8859-1 +pt_PT@euro ISO-8859-15 +quz_PE UTF-8 +raj_IN UTF-8 +ro_RO.UTF-8 UTF-8 +ro_RO ISO-8859-2 +ru_RU.KOI8-R KOI8-R +ru_RU.UTF-8 UTF-8 +ru_RU ISO-8859-5 +ru_UA.UTF-8 UTF-8 +ru_UA KOI8-U +rw_RW UTF-8 +sa_IN UTF-8 +sat_IN UTF-8 +sc_IT UTF-8 +sd_IN UTF-8 +sd_IN@devanagari UTF-8 +se_NO UTF-8 +sgs_LT UTF-8 +shn_MM UTF-8 +shs_CA UTF-8 +si_LK UTF-8 +sid_ET UTF-8 +sk_SK.UTF-8 UTF-8 +sk_SK ISO-8859-2 +sl_SI.UTF-8 UTF-8 +sl_SI ISO-8859-2 +sm_WS UTF-8 +so_DJ.UTF-8 UTF-8 +so_DJ ISO-8859-1 +so_ET UTF-8 +so_KE.UTF-8 UTF-8 +so_KE ISO-8859-1 +so_SO.UTF-8 UTF-8 +so_SO ISO-8859-1 +sq_AL.UTF-8 UTF-8 +sq_AL ISO-8859-1 +sq_MK UTF-8 +sr_ME UTF-8 +sr_RS UTF-8 +sr_RS@latin UTF-8 +ss_ZA UTF-8 +st_ZA.UTF-8 UTF-8 +st_ZA ISO-8859-1 +sv_FI.UTF-8 UTF-8 +sv_FI ISO-8859-1 +sv_FI@euro ISO-8859-15 +sv_SE.UTF-8 UTF-8 +sv_SE ISO-8859-1 +sw_KE UTF-8 +sw_TZ UTF-8 +szl_PL UTF-8 +ta_IN UTF-8 +ta_LK UTF-8 +tcy_IN.UTF-8 UTF-8 +te_IN UTF-8 +tg_TJ.UTF-8 UTF-8 +tg_TJ KOI8-T +th_TH.UTF-8 UTF-8 +th_TH TIS-620 +the_NP UTF-8 +ti_ER UTF-8 +ti_ET UTF-8 +tig_ER UTF-8 +tk_TM UTF-8 +tl_PH.UTF-8 UTF-8 +tl_PH ISO-8859-1 +tn_ZA UTF-8 +to_TO UTF-8 +tpi_PG UTF-8 +tr_CY.UTF-8 UTF-8 +tr_CY ISO-8859-9 +tr_TR.UTF-8 UTF-8 +tr_TR ISO-8859-9 +ts_ZA UTF-8 +tt_RU UTF-8 +tt_RU@iqtelif UTF-8 +ug_CN UTF-8 +uk_UA.UTF-8 UTF-8 +uk_UA KOI8-U +unm_US UTF-8 +ur_IN UTF-8 +ur_PK UTF-8 +uz_UZ.UTF-8 UTF-8 +uz_UZ ISO-8859-1 +uz_UZ@cyrillic UTF-8 +ve_ZA UTF-8 +vi_VN UTF-8 +wa_BE ISO-8859-1 +wa_BE@euro ISO-8859-15 +wa_BE.UTF-8 UTF-8 +wae_CH UTF-8 +wal_ET UTF-8 +wo_SN UTF-8 +xh_ZA.UTF-8 UTF-8 +xh_ZA ISO-8859-1 +yi_US.UTF-8 UTF-8 +yi_US CP1255 +yo_NG UTF-8 +yue_HK UTF-8 +yuw_PG UTF-8 +zh_CN.GB18030 GB18030 +zh_CN.GBK GBK +zh_CN.UTF-8 UTF-8 +zh_CN GB2312 +zh_HK.UTF-8 UTF-8 +zh_HK BIG5-HKSCS +zh_SG.UTF-8 UTF-8 +zh_SG.GBK GBK +zh_SG GB2312 +zh_TW.EUC-TW EUC-TW +zh_TW.UTF-8 UTF-8 +zh_TW BIG5 +zu_ZA.UTF-8 UTF-8 +zu_ZA ISO-8859-1 diff --git a/gnu/installer/aux-files/logo.txt b/gnu/installer/aux-files/logo.txt new file mode 100644 index 0000000000..52418d88c1 --- /dev/null +++ b/gnu/installer/aux-files/logo.txt @@ -0,0 +1,19 @@ + ░░░ ░░░ + ░░▒▒░░░░░░░░░ ░░░░░░░░░▒▒░░ + ░░▒▒▒▒▒░░░░░░░ ░░░░░░░▒▒▒▒▒░ + ░▒▒▒░░▒▒▒▒▒ ░░░░░░░▒▒░ + ░▒▒▒▒░ ░░░░░░ + ▒▒▒▒▒ ░░░░░░ + ▒▒▒▒▒ ░░░░░ + ░▒▒▒▒▒ ░░░░░ + ▒▒▒▒▒ ░░░░░ + ▒▒▒▒▒ ░░░░░ + ░▒▒▒▒▒░░░░░ + ▒▒▒▒▒▒░░░ + ▒▒▒▒▒▒░ + _____ _ _ _ _ _____ _ + / ____| \ | | | | | / ____| (_) +| | __| \| | | | | | | __ _ _ ___ __ +| | |_ | . ' | | | | | | |_ | | | | \ \/ / +| |__| | |\ | |__| | | |__| | |_| | |> < + \_____|_| \_|\____/ \_____|\__,_|_/_/\_\ diff --git a/gnu/installer/connman.scm b/gnu/installer/connman.scm new file mode 100644 index 0000000000..740df7424a --- /dev/null +++ b/gnu/installer/connman.scm @@ -0,0 +1,400 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Mathieu Othacehe +;;; +;;; 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 . + +(define-module (gnu installer connman) + #:use-module (gnu installer utils) + #:use-module (guix records) + #:use-module (ice-9 match) + #:use-module (ice-9 popen) + #:use-module (ice-9 regex) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:export ( + technology + technology? + technology-name + technology-type + technology-powered? + technology-connected? + + + service + service? + service-name + service-type + service-path + service-strength + service-state + + &connman-error + connman-error? + connman-error-command + connman-error-output + connman-error-status + + &connman-connection-error + connman-connection-error? + connman-connection-error-service + connman-connection-error-output + + &connman-password-error + connman-password-error? + + &connman-already-connected-error + connman-already-connected-error? + + connman-state + connman-technologies + connman-enable-technology + connman-disable-technology + connman-scan-technology + connman-services + connman-connect + connman-disconnect + connman-online? + connman-connect-with-auth)) + +;;; Commentary: +;;; +;;; This module provides procedures for talking with the connman daemon. +;;; The best approach would have been using connman dbus interface. +;;; However, as Guile dbus bindings are not available yet, the console client +;;; "connmanctl" is used to talk with the daemon. +;;; + + +;;; +;;; Technology record. +;;; + +;; The record encapsulates the "Technology" object of connman. +;; Technology type will be typically "ethernet", "wifi" or "bluetooth". + +(define-record-type* + technology make-technology + technology? + (name technology-name) ; string + (type technology-type) ; string + (powered? technology-powered?) ; boolean + (connected? technology-connected?)) ; boolean + + +;;; +;;; Service record. +;;; + +;; The record encapsulates the "Service" object of connman. +;; Service type is the same as the technology it is associated to, path is a +;; unique identifier given by connman, strength describes the signal quality +;; if applicable. Finally, state is "idle", "failure", "association", +;; "configuration", "ready", "disconnect" or "online". + +(define-record-type* + service make-service + service? + (name service-name) ; string + (type service-type) ; string + (path service-path) ; string + (strength service-strength) ; integer + (state service-state)) ; string + + +;;; +;;; Condition types. +;;; + +(define-condition-type &connman-error &error + connman-error? + (command connman-error-command) + (output connman-error-output) + (status connman-error-status)) + +(define-condition-type &connman-connection-error &error + connman-connection-error? + (service connman-connection-error-service) + (output connman-connection-error-output)) + +(define-condition-type &connman-password-error &connman-connection-error + connman-password-error?) + +(define-condition-type &connman-already-connected-error + &connman-connection-error connman-already-connected-error?) + + +;;; +;;; Procedures. +;;; + +(define (connman-run command env arguments) + "Run the given COMMAND, with the specified ENV and ARGUMENTS. The error +output is discarded and &connman-error condition is raised if the command +returns a non zero exit code." + (let* ((command `("env" ,env ,command ,@arguments "2>" "/dev/null")) + (command-string (string-join command " ")) + (pipe (open-input-pipe command-string)) + (output (read-lines pipe)) + (ret (close-pipe pipe))) + (case (status:exit-val ret) + ((0) output) + (else (raise (condition (&connman-error + (command command) + (output output) + (status ret)))))))) + +(define (connman . arguments) + "Run connmanctl with the specified ARGUMENTS. Set the LANG environment +variable to C because the command output will be parsed and we don't want it +to be translated." + (connman-run "connmanctl" "LANG=C" arguments)) + +(define (parse-keys keys) + "Parse the given list of strings KEYS, under the following format: + + '((\"KEY = VALUE\") (\"KEY2 = VALUE2\") ...) + +Return the corresponding association list of '((KEY . VALUE) (KEY2 . VALUE2) +...) elements." + (let ((key-regex (make-regexp "([^ ]+) = ([^$]+)"))) + (map (lambda (key) + (let ((match-key (regexp-exec key-regex key))) + (cons (match:substring match-key 1) + (match:substring match-key 2)))) + keys))) + +(define (connman-state) + "Return the state of connman. The nominal states are 'offline, 'idle, +'ready, 'oneline. If an unexpected state is read, 'unknown is +returned. Finally, an error is raised if the comman output could not be +parsed, usually because the connman daemon is not responding." + (let* ((output (connman "state")) + (state-keys (parse-keys output))) + (let ((state (assoc-ref state-keys "State"))) + (if state + (cond ((string=? state "offline") 'offline) + ((string=? state "idle") 'idle) + ((string=? state "ready") 'ready) + ((string=? state "online") 'online) + (else 'unknown)) + (raise (condition + (&message + (message "Could not determine the state of connman.")))))))) + +(define (split-technology-list technologies) + "Parse the given strings list TECHNOLOGIES, under the following format: + + '((\"/net/connman/technology/xxx\") + (\"KEY = VALUE\") + ... + (\"/net/connman/technology/yyy\") + (\"KEY2 = VALUE2\") + ...) + Return the corresponding '(((\"KEY = VALUE\") ...) ((\"KEY2 = VALUE2\") ...)) +list so that each keys of a given technology are gathered in a separate list." + (let loop ((result '()) + (cur-list '()) + (input (reverse technologies))) + (if (null? input) + result + (let ((item (car input))) + (if (string-match "/net/connman/technology" item) + (loop (cons cur-list result) '() (cdr input)) + (loop result (cons item cur-list) (cdr input))))))) + +(define (string->boolean string) + (equal? string "True")) + +(define (connman-technologies) + "Return a list of available records." + + (define (technology-output->technology output) + (let ((keys (parse-keys output))) + (technology + (name (assoc-ref keys "Name")) + (type (assoc-ref keys "Type")) + (powered? (string->boolean (assoc-ref keys "Powered"))) + (connected? (string->boolean (assoc-ref keys "Connected")))))) + + (let* ((output (connman "technologies")) + (technologies (split-technology-list output))) + (map technology-output->technology technologies))) + +(define (connman-enable-technology technology) + "Enable the given TECHNOLOGY." + (let ((type (technology-type technology))) + (connman "enable" type))) + +(define (connman-disable-technology technology) + "Disable the given TECHNOLOGY." + (let ((type (technology-type technology))) + (connman "disable" type))) + +(define (connman-scan-technology technology) + "Run a scan for the given TECHNOLOGY." + (let ((type (technology-type technology))) + (connman "scan" type))) + +(define (connman-services) + "Return a list of available records." + + (define (service-output->service path output) + (let* ((service-keys + (match output + ((_ . rest) rest))) + (keys (parse-keys service-keys))) + (service + (name (assoc-ref keys "Name")) + (type (assoc-ref keys "Type")) + (path path) + (strength (and=> (assoc-ref keys "Strength") string->number)) + (state (assoc-ref keys "State"))))) + + (let* ((out (connman "services")) + (out-filtered (delete "" out)) + (services-path (map (lambda (service) + (match (string-split service #\ ) + ((_ ... path) path))) + out-filtered)) + (services-output (map (lambda (service) + (connman "services" service)) + services-path))) + (map service-output->service services-path services-output))) + +(define (connman-connect service) + "Connect to the given SERVICE." + (let ((path (service-path service))) + (connman "connect" path))) + +(define (connman-disconnect service) + "Disconnect from the given SERVICE." + (let ((path (service-path service))) + (connman "disconnect" path))) + +(define (connman-online?) + (let ((state (connman-state))) + (eq? state 'online))) + +(define (connman-connect-with-auth service password-proc) + "Connect to the given SERVICE with the password returned by calling +PASSWORD-PROC. This is only possible in the interactive mode of connmanctl +because authentication is done by communicating with an agent. + +As the open-pipe procedure of Guile do not allow to read from stderr, we have +to merge stdout and stderr using bash redirection. Then error messages are +extracted from connmanctl output using a regexp. This makes the whole +procedure even more unreliable. + +Raise &connman-connection-error if an error occured during connection. Raise +&connman-password-error if the given password is incorrect." + + (define connman-error-regexp (make-regexp "Error[ ]*([^\n]+)\n")) + + (define (match-connman-error str) + (let ((match-error (regexp-exec connman-error-regexp str))) + (and match-error (match:substring match-error 1)))) + + (define* (read-regexps-or-error port regexps error-handler) + "Read characters from port until an error is detected, or one of the given +REGEXPS is matched. If an error is detected, call ERROR-HANDLER with the error +string as argument. Raise an error if the eof is reached before one of the +regexps is matched." + (let loop ((res "")) + (let ((char (read-char port))) + (cond + ((eof-object? char) + (raise (condition + (&message + (message "Unable to find expected regexp."))))) + ((match-connman-error res) + => + (lambda (match) + (error-handler match))) + ((or-map (lambda (regexp) + (and (regexp-exec regexp res) regexp)) + regexps) + => + (lambda (match) + match)) + (else + (loop (string-append res (string char)))))))) + + (define* (read-regexp-or-error port regexp error-handler) + "Same as READ-REGEXPS-OR-ERROR above, but with a single REGEXP." + (read-regexps-or-error port (list regexp) error-handler)) + + (define (connman-error->condition path error) + (cond + ((string-match "Already connected" error) + (condition (&connman-already-connected-error + (service path) + (output error)))) + (else + (condition (&connman-connection-error + (service path) + (output error)))))) + + (define (run-connection-sequence pipe) + "Run the connection sequence using PIPE as an opened port to an +interactive connmanctl process." + (let* ((path (service-path service)) + (error-handler (lambda (error) + (raise + (connman-error->condition path error))))) + ;; Start the agent. + (format pipe "agent on\n") + (read-regexp-or-error pipe (make-regexp "Agent registered") error-handler) + + ;; Let's try to connect to the service. If the service does not require + ;; a password, the connection might succeed right after this call. + ;; Otherwise, connmanctl will prompt us for a password. + (format pipe "connect ~a\n" path) + (let* ((connected-regexp (make-regexp (format #f "Connected ~a" path))) + (passphrase-regexp (make-regexp "\nPassphrase\\?[ ]*")) + (regexps (list connected-regexp passphrase-regexp)) + (result (read-regexps-or-error pipe regexps error-handler))) + + ;; A password is required. + (when (eq? result passphrase-regexp) + (format pipe "~a~%" (password-proc)) + + ;; Now, we have to wait for the connection to succeed. If an error + ;; occurs, it is most likely because the password is incorrect. + ;; In that case, we escape from an eventual retry loop that would + ;; add complexity to this procedure, and raise a + ;; &connman-password-error condition. + (read-regexp-or-error pipe connected-regexp + (lambda (error) + ;; Escape from retry loop. + (format pipe "no\n") + (raise + (condition (&connman-password-error + (service path) + (output error)))))))))) + + ;; XXX: Find a better way to read stderr, like with the "subprocess" + ;; procedure of racket that return input ports piped on the process stdin and + ;; stderr. + (let ((pipe (open-pipe "connmanctl 2>&1" OPEN_BOTH))) + (dynamic-wind + (const #t) + (lambda () + (run-connection-sequence pipe) + #t) + (lambda () + (format pipe "quit\n") + (close-pipe pipe))))) diff --git a/gnu/installer/final.scm b/gnu/installer/final.scm new file mode 100644 index 0000000000..e1c62f5ce0 --- /dev/null +++ b/gnu/installer/final.scm @@ -0,0 +1,36 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Mathieu Othacehe +;;; +;;; 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 . + +(define-module (gnu installer final) + #:use-module (gnu installer newt page) + #:use-module (gnu installer steps) + #:use-module (gnu installer utils) + #:use-module (gnu services herd) + #:use-module (guix build utils) + #:export (install-system)) + +(define (install-system) + "Start COW-STORE service on target directory and launch guix install command +in a subshell." + (let ((install-command + (format #f "guix system init ~a ~a" + (%installer-configuration-file) + (%installer-target-dir)))) + (mkdir-p (%installer-target-dir)) + (start-service 'cow-store (list (%installer-target-dir))) + (false-if-exception (run-shell-command install-command)))) diff --git a/gnu/installer/hostname.scm b/gnu/installer/hostname.scm new file mode 100644 index 0000000000..b8e823d0a8 --- /dev/null +++ b/gnu/installer/hostname.scm @@ -0,0 +1,23 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Mathieu Othacehe +;;; +;;; 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 . + +(define-module (gnu installer hostname) + #:export (hostname->configuration)) + +(define (hostname->configuration hostname) + `((host-name ,hostname))) diff --git a/gnu/installer/keymap.scm b/gnu/installer/keymap.scm new file mode 100644 index 0000000000..d66b376d9c --- /dev/null +++ b/gnu/installer/keymap.scm @@ -0,0 +1,172 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Mathieu Othacehe +;;; +;;; 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 . + +(define-module (gnu installer keymap) + #:use-module (guix records) + #:use-module (sxml match) + #:use-module (sxml simple) + #:use-module (ice-9 binary-ports) + #:use-module (ice-9 ftw) + #:use-module (ice-9 match) + #:use-module (ice-9 regex) + #:export ( + x11-keymap-model + make-x11-keymap-model + x11-keymap-model? + x11-keymap-model-name + x11-keymap-model-description + + + x11-keymap-layout + make-x11-keymap-layout + x11-keymap-layout? + x11-keymap-layout-name + x11-keymap-layout-description + x11-keymap-layout-variants + + + x11-keymap-variant + make-x11-keymap-variant + x11-keymap-variant? + x11-keymap-variant-name + x11-keymap-variant-description + + default-keyboard-model + xkb-rules->models+layouts + kmscon-update-keymap)) + +(define-record-type* + x11-keymap-model make-x11-keymap-model + x11-keymap-model? + (name x11-keymap-model-name) ;string + (description x11-keymap-model-description)) ;string + +(define-record-type* + x11-keymap-layout make-x11-keymap-layout + x11-keymap-layout? + (name x11-keymap-layout-name) ;string + (description x11-keymap-layout-description) ;string + (variants x11-keymap-layout-variants)) ;list of + +(define-record-type* + x11-keymap-variant make-x11-keymap-variant + x11-keymap-variant? + (name x11-keymap-variant-name) ;string + (description x11-keymap-variant-description)) ;string + +;; Assume all modern keyboards have this model. +(define default-keyboard-model (make-parameter "pc105")) + +(define (xkb-rules->models+layouts file) + "Parse FILE and return two values, the list of supported X11-KEYMAP-MODEL +and X11-KEYMAP-LAYOUT records. FILE is an XML file from the X Keyboard +Configuration Database, describing possible XKB configurations." + (define (model m) + (sxml-match m + [(model + (configItem + (name ,name) + (description ,description) + . ,rest)) + (x11-keymap-model + (name name) + (description description))])) + + (define (variant v) + (sxml-match v + [(variant + ;; According to xbd-rules DTD, the definition of a + ;; configItem is: + ;; + ;; shortDescription and description are optional elements + ;; but sxml-match does not support default values for + ;; elements (only attributes). So to avoid writing as many + ;; patterns as existing possibilities, gather all the + ;; remaining elements but name in REST-VARIANT. + (configItem + (name ,name) + . ,rest-variant)) + (x11-keymap-variant + (name name) + (description (car + (assoc-ref rest-variant 'description))))])) + + (define (layout l) + (sxml-match l + [(layout + (configItem + (name ,name) + . ,rest-layout) + (variantList ,[variant -> v] ...)) + (x11-keymap-layout + (name name) + (description (car + (assoc-ref rest-layout 'description))) + (variants (list v ...)))] + [(layout + (configItem + (name ,name) + . ,rest-layout)) + (x11-keymap-layout + (name name) + (description (car + (assoc-ref rest-layout 'description))) + (variants '()))])) + + (let ((sxml (call-with-input-file file + (lambda (port) + (xml->sxml port #:trim-whitespace? #t))))) + (match + (sxml-match sxml + [(*TOP* + ,pi + (xkbConfigRegistry + (@ . ,ignored) + (modelList ,[model -> m] ...) + (layoutList ,[layout -> l] ...) + . ,rest)) + (list + (list m ...) + (list l ...))]) + ((models layouts) + (values models layouts))))) + +(define (kmscon-update-keymap model layout variant) + "Update kmscon keymap with the provided MODEL, LAYOUT and VARIANT." + (and=> + (getenv "KEYMAP_UPDATE") + (lambda (keymap-file) + (unless (file-exists? keymap-file) + (error "Unable to locate keymap update file")) + + ;; See file gnu/packages/patches/kmscon-runtime-keymap-switch.patch. + ;; This dirty hack makes possible to update kmscon keymap at runtime by + ;; writing an X11 keyboard model, layout and variant to a named pipe + ;; referred by KEYMAP_UPDATE environment variable. + (call-with-output-file keymap-file + (lambda (port) + (format port model) + (put-u8 port 0) + + (format port layout) + (put-u8 port 0) + + (format port variant) + (put-u8 port 0)))))) diff --git a/gnu/installer/locale.scm b/gnu/installer/locale.scm new file mode 100644 index 0000000000..2b45b2200a --- /dev/null +++ b/gnu/installer/locale.scm @@ -0,0 +1,210 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Mathieu Othacehe +;;; +;;; 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 . + +(define-module (gnu installer locale) + #:use-module (gnu installer utils) + #:use-module (guix records) + #:use-module (json) + #:use-module (srfi srfi-1) + #:use-module (ice-9 match) + #:use-module (ice-9 regex) + #:export (locale-language + locale-territory + locale-codeset + locale-modifier + + locale->locale-string + supported-locales->locales + + iso639->iso639-languages + language-code->language-name + + iso3166->iso3166-territories + territory-code->territory-name + + locale->configuration)) + + +;;; +;;; Locale. +;;; + +;; A glibc locale string has the following format: +;; language[_territory[.codeset][@modifier]]. +(define locale-regexp "^([^_@]+)(_([^\\.@]+))?(\\.([^@]+))?(@([^$]+))?$") + +;; LOCALE will be better expressed in a (guix record) that in an association +;; list. However, loading large files containing records does not scale +;; well. The same thing goes for ISO639 and ISO3166 association lists used +;; later in this module. +(define (locale-language assoc) + (assoc-ref assoc 'language)) +(define (locale-territory assoc) + (assoc-ref assoc 'territory)) +(define (locale-codeset assoc) + (assoc-ref assoc 'codeset)) +(define (locale-modifier assoc) + (assoc-ref assoc 'modifier)) + +(define (locale-string->locale string) + "Return the locale association list built from the parsing of STRING." + (let ((matches (string-match locale-regexp string))) + `((language . ,(match:substring matches 1)) + (territory . ,(match:substring matches 3)) + (codeset . ,(match:substring matches 5)) + (modifier . ,(match:substring matches 7))))) + +(define (locale->locale-string locale) + "Reverse operation of locale-string->locale." + (let ((language (locale-language locale)) + (territory (locale-territory locale)) + (codeset (locale-codeset locale)) + (modifier (locale-modifier locale))) + (apply string-append + `(,language + ,@(if territory + `("_" ,territory) + '()) + ,@(if codeset + `("." ,codeset) + '()) + ,@(if modifier + `("@" ,modifier) + '()))))) + +(define (supported-locales->locales supported-locales) + "Parse the SUPPORTED-LOCALES file from the glibc and return the matching +list of LOCALE association lists." + (call-with-input-file supported-locales + (lambda (port) + (let ((lines (read-lines port))) + (map (lambda (line) + (match (string-split line #\ ) + ((locale-string codeset) + (let ((line-locale (locale-string->locale locale-string))) + (assoc-set! line-locale 'codeset codeset))))) + lines))))) + + +;;; +;;; Language. +;;; + +(define (iso639-language-alpha2 assoc) + (assoc-ref assoc 'alpha2)) + +(define (iso639-language-alpha3 assoc) + (assoc-ref assoc 'alpha3)) + +(define (iso639-language-name assoc) + (assoc-ref assoc 'name)) + +(define (supported-locale? locales alpha2 alpha3) + "Find a locale in LOCALES whose alpha2 field matches ALPHA-2 or alpha3 field +matches ALPHA-3. The ISO639 standard specifies that ALPHA-2 is optional. Thus, +if ALPHA-2 is #f, only consider ALPHA-3. Return #f if not matching locale was +found." + (find (lambda (locale) + (let ((language (locale-language locale))) + (or (and=> alpha2 + (lambda (code) + (string=? language code))) + (string=? language alpha3)))) + locales)) + +(define (iso639->iso639-languages locales iso639-3 iso639-5) + "Return a list of ISO639 association lists created from the parsing of +ISO639-3 and ISO639-5 files." + (call-with-input-file iso639-3 + (lambda (port-iso639-3) + (call-with-input-file iso639-5 + (lambda (port-iso639-5) + (filter-map + (lambda (hash) + (let ((alpha2 (hash-ref hash "alpha_2")) + (alpha3 (hash-ref hash "alpha_3")) + (name (hash-ref hash "name"))) + (and (supported-locale? locales alpha2 alpha3) + `((alpha2 . ,alpha2) + (alpha3 . ,alpha3) + (name . ,name))))) + (append + (hash-ref (json->scm port-iso639-3) "639-3") + (hash-ref (json->scm port-iso639-5) "639-5")))))))) + +(define (language-code->language-name languages language-code) + "Using LANGUAGES as a list of ISO639 association lists, return the language +name corresponding to the given LANGUAGE-CODE." + (let ((iso639-language + (find (lambda (language) + (or + (and=> (iso639-language-alpha2 language) + (lambda (alpha2) + (string=? alpha2 language-code))) + (string=? (iso639-language-alpha3 language) + language-code))) + languages))) + (iso639-language-name iso639-language))) + + +;;; +;;; Territory. +;;; + +(define (iso3166-territory-alpha2 assoc) + (assoc-ref assoc 'alpha2)) + +(define (iso3166-territory-alpha3 assoc) + (assoc-ref assoc 'alpha3)) + +(define (iso3166-territory-name assoc) + (assoc-ref assoc 'name)) + +(define (iso3166->iso3166-territories iso3166) + "Return a list of ISO3166 association lists created from the parsing of +ISO3166 file." + (call-with-input-file iso3166 + (lambda (port) + (map (lambda (hash) + `((alpha2 . ,(hash-ref hash "alpha_2")) + (alpha3 . ,(hash-ref hash "alpha_3")) + (name . ,(hash-ref hash "name")))) + (hash-ref (json->scm port) "3166-1"))))) + +(define (territory-code->territory-name territories territory-code) + "Using TERRITORIES as a list of ISO3166 association lists return the +territory name corresponding to the given TERRITORY-CODE." + (let ((iso3166-territory + (find (lambda (territory) + (or + (and=> (iso3166-territory-alpha2 territory) + (lambda (alpha2) + (string=? alpha2 territory-code))) + (string=? (iso3166-territory-alpha3 territory) + territory-code))) + territories))) + (iso3166-territory-name iso3166-territory))) + + +;;; +;;; Configuration formatter. +;;; + +(define (locale->configuration locale) + "Return the configuration field for LOCALE." + `((locale ,locale))) diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm new file mode 100644 index 0000000000..6c44b4acf6 --- /dev/null +++ b/gnu/installer/newt.scm @@ -0,0 +1,128 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Mathieu Othacehe +;;; +;;; 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 . + +(define-module (gnu installer newt) + #:use-module (gnu installer record) + #:use-module (gnu installer utils) + #:use-module (gnu installer newt ethernet) + #:use-module (gnu installer newt final) + #:use-module (gnu installer newt hostname) + #:use-module (gnu installer newt keymap) + #:use-module (gnu installer newt locale) + #:use-module (gnu installer newt menu) + #:use-module (gnu installer newt network) + #:use-module (gnu installer newt page) + #:use-module (gnu installer newt partition) + #:use-module (gnu installer newt services) + #:use-module (gnu installer newt timezone) + #:use-module (gnu installer newt user) + #:use-module (gnu installer newt utils) + #:use-module (gnu installer newt welcome) + #:use-module (gnu installer newt wifi) + #:use-module (guix config) + #:use-module (guix discovery) + #:use-module (guix i18n) + #:use-module (srfi srfi-26) + #:use-module (newt) + #:export (newt-installer)) + +(define (init) + (newt-init) + (clear-screen) + (set-screen-size!)) + +(define (exit) + (newt-finish) + (clear-screen)) + +(define (exit-error file key args) + (newt-set-color COLORSET-ROOT "white" "red") + (let ((width (nearest-exact-integer + (* (screen-columns) 0.8))) + (height (nearest-exact-integer + (* (screen-rows) 0.7)))) + (run-file-textbox-page + #:info-text (format #f (G_ "The installer has encountered an unexpected \ +problem. The backtrace is displayed below. Please report it by email to \ +<~a>.") %guix-bug-report-address) + #:title (G_ "Unexpected problem") + #:file file + #:exit-button? #f + #:info-textbox-width width + #:file-textbox-width width + #:file-textbox-height height)) + (newt-set-color COLORSET-ROOT "white" "blue") + (newt-finish) + (clear-screen)) + +(define (final-page result prev-steps) + (run-final-page result prev-steps)) + +(define* (locale-page #:key + supported-locales + iso639-languages + iso3166-territories) + (run-locale-page + #:supported-locales supported-locales + #:iso639-languages iso639-languages + #:iso3166-territories iso3166-territories)) + +(define (timezone-page zonetab) + (run-timezone-page zonetab)) + +(define (welcome-page logo) + (run-welcome-page logo)) + +(define (menu-page steps) + (run-menu-page steps)) + +(define* (keymap-page layouts) + (run-keymap-page layouts)) + +(define (network-page) + (run-network-page)) + +(define (hostname-page) + (run-hostname-page)) + +(define (user-page) + (run-user-page)) + +(define (partition-page) + (run-partioning-page)) + +(define (services-page) + (run-services-page)) + +(define newt-installer + (installer + (name 'newt) + (init init) + (exit exit) + (exit-error exit-error) + (final-page final-page) + (keymap-page keymap-page) + (locale-page locale-page) + (menu-page menu-page) + (network-page network-page) + (timezone-page timezone-page) + (hostname-page hostname-page) + (user-page user-page) + (partition-page partition-page) + (services-page services-page) + (welcome-page welcome-page))) diff --git a/gnu/installer/newt/ethernet.scm b/gnu/installer/newt/ethernet.scm new file mode 100644 index 0000000000..d1f357243b --- /dev/null +++ b/gnu/installer/newt/ethernet.scm @@ -0,0 +1,81 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Mathieu Othacehe +;;; +;;; 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 . + +(define-module (gnu installer newt ethernet) + #:use-module (gnu installer connman) + #:use-module (gnu installer steps) + #:use-module (gnu installer newt utils) + #:use-module (gnu installer newt page) + #:use-module (guix i18n) + #:use-module (ice-9 format) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:use-module (newt) + #:export (run-ethernet-page)) + +(define (ethernet-services) + "Return all the connman services of ethernet type." + (let ((services (connman-services))) + (filter (lambda (service) + (and (string=? (service-type service) "ethernet") + (not (string-null? (service-name service))))) + services))) + +(define (ethernet-service->text service) + "Return a string describing the given ethernet SERVICE." + (let* ((name (service-name service)) + (path (service-path service)) + (full-name (string-append name "-" path)) + (state (service-state service)) + (connected? (or (string=? state "online") + (string=? state "ready")))) + (format #f "~c ~a~%" + (if connected? #\* #\ ) + full-name))) + +(define (connect-ethernet-service service) + "Connect to the given ethernet SERVICE. Display a connecting page while the +connection is pending." + (let* ((service-name (service-name service)) + (form (draw-connecting-page service-name))) + (connman-connect service) + (destroy-form-and-pop form) + service)) + +(define (run-ethernet-page) + (let ((services (ethernet-services))) + (if (null? services) + (begin + (run-error-page + (G_ "No ethernet service available, please try again.") + (G_ "No service")) + (raise + (condition + (&installer-step-abort)))) + (run-listbox-selection-page + #:info-text (G_ "Please select an ethernet network.") + #:title (G_ "Ethernet connection") + #:listbox-items services + #:listbox-item->text ethernet-service->text + #:button-text (G_ "Exit") + #:button-callback-procedure + (lambda _ + (raise + (condition + (&installer-step-abort)))) + #:listbox-callback-procedure connect-ethernet-service)))) diff --git a/gnu/installer/newt/final.scm b/gnu/installer/newt/final.scm new file mode 100644 index 0000000000..645c1e8689 --- /dev/null +++ b/gnu/installer/newt/final.scm @@ -0,0 +1,86 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Mathieu Othacehe +;;; +;;; 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 . + +(define-module (gnu installer newt final) + #:use-module (gnu installer final) + #:use-module (gnu installer parted) + #:use-module (gnu installer steps) + #:use-module (gnu installer utils) + #:use-module (gnu installer newt page) + #:use-module (gnu installer newt utils) + #:use-module (guix i18n) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:use-module (newt) + #:export (run-final-page)) + +(define (run-config-display-page) + (let ((width (%configuration-file-width)) + (height (nearest-exact-integer + (/ (screen-rows) 2)))) + (run-file-textbox-page + #:info-text (G_ "We're now ready to proceed with the installation! \ +A system configuration file has been generated, it is displayed below. \ +The new system will be created from this file once you've pressed OK. \ +This will take a few minutes.") + #:title (G_ "Configuration file") + #:file (%installer-configuration-file) + #:info-textbox-width width + #:file-textbox-width width + #:file-textbox-height height + #:exit-button-callback-procedure + (lambda () + (raise + (condition + (&installer-step-abort))))))) + +(define (run-install-success-page) + (message-window + (G_ "Installation complete") + (G_ "Reboot") + (G_ "Congratulations! Installation is now complete. \ +You may remove the device containing the installation image and \ +press the button to reboot."))) + +(define (run-install-failed-page) + (choice-window + (G_ "Installation failed") + (G_ "Restart installer") + (G_ "Retry system install") + (G_ "The final system installation step failed. You can retry the \ +last step, or restart the installer."))) + +(define (run-install-shell) + (clear-screen) + (newt-suspend) + (let ((install-ok? (install-system))) + (newt-resume) + install-ok?)) + +(define (run-final-page result prev-steps) + (let* ((configuration (format-configuration prev-steps result)) + (user-partitions (result-step result 'partition)) + (install-ok? + (with-mounted-partitions + user-partitions + (configuration->file configuration) + (run-config-display-page) + (run-install-shell)))) + (if install-ok? + (run-install-success-page) + (run-install-failed-page)))) diff --git a/gnu/installer/newt/hostname.scm b/gnu/installer/newt/hostname.scm new file mode 100644 index 0000000000..7783fa6360 --- /dev/null +++ b/gnu/installer/newt/hostname.scm @@ -0,0 +1,26 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Mathieu Othacehe +;;; +;;; 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 . + +(define-module (gnu installer newt hostname) + #:use-module (gnu installer newt page) + #:use-module (guix i18n) + #:export (run-hostname-page)) + +(define (run-hostname-page) + (run-input-page (G_ "Please enter the system hostname.") + (G_ "Hostname"))) diff --git a/gnu/installer/newt/keymap.scm b/gnu/installer/newt/keymap.scm new file mode 100644 index 0000000000..6211af2bc5 --- /dev/null +++ b/gnu/installer/newt/keymap.scm @@ -0,0 +1,122 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Mathieu Othacehe +;;; +;;; 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 . + +(define-module (gnu installer newt keymap) + #:use-module (gnu installer keymap) + #:use-module (gnu installer steps) + #:use-module (gnu installer newt page) + #:use-module (guix i18n) + #:use-module (guix records) + #:use-module (newt) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:export (run-keymap-page)) + +(define (run-layout-page layouts layout->text) + (let ((title (G_ "Layout"))) + (run-listbox-selection-page + #:title title + #:info-text (G_ "Please choose your keyboard layout.") + #:listbox-items layouts + #:listbox-item->text layout->text + #:sort-listbox-items? #f + #:button-text (G_ "Exit") + #:button-callback-procedure + (lambda _ + (raise + (condition + (&installer-step-abort))))))) + +(define (run-variant-page variants variant->text) + (let ((title (G_ "Variant"))) + (run-listbox-selection-page + #:title title + #:info-text (G_ "Please choose a variant for your keyboard layout.") + #:listbox-items variants + #:listbox-item->text variant->text + #:sort-listbox-items? #f + #:button-text (G_ "Back") + #:button-callback-procedure + (lambda _ + (raise + (condition + (&installer-step-abort))))))) + +(define (sort-layouts layouts) + "Sort LAYOUTS list by putting the US layout ahead and return it." + (call-with-values + (lambda () + (partition + (lambda (layout) + (let ((name (x11-keymap-layout-name layout))) + (string=? name "us"))) + layouts)) + (cut append <> <>))) + +(define (sort-variants variants) + "Sort VARIANTS list by putting the internation variant ahead and return it." + (call-with-values + (lambda () + (partition + (lambda (variant) + (let ((name (x11-keymap-variant-name variant))) + (string=? name "altgr-intl"))) + variants)) + (cut append <> <>))) + +(define* (run-keymap-page layouts) + "Run a page asking the user to select a keyboard layout and variant. LAYOUTS +is a list of supported X11-KEYMAP-LAYOUT. Return a list of two elements, the +names of the selected keyboard layout and variant." + (define keymap-steps + (list + (installer-step + (id 'layout) + (compute + (lambda _ + (run-layout-page + (sort-layouts layouts) + (lambda (layout) + (x11-keymap-layout-description layout)))))) + ;; Propose the user to select a variant among those supported by the + ;; previously selected layout. + (installer-step + (id 'variant) + (compute + (lambda (result _) + (let* ((layout (result-step result 'layout)) + (variants (x11-keymap-layout-variants layout))) + ;; Return #f if the layout does not have any variant. + (and (not (null? variants)) + (run-variant-page + (sort-variants variants) + (lambda (variant) + (x11-keymap-variant-description + variant)))))))))) + + (define (format-result result) + (let ((layout (x11-keymap-layout-name + (result-step result 'layout))) + (variant (and=> (result-step result 'variant) + (lambda (variant) + (x11-keymap-variant-name variant))))) + (list layout (or variant "")))) + (format-result + (run-installer-steps #:steps keymap-steps))) diff --git a/gnu/installer/newt/locale.scm b/gnu/installer/newt/locale.scm new file mode 100644 index 0000000000..4fa07df81e --- /dev/null +++ b/gnu/installer/newt/locale.scm @@ -0,0 +1,217 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Mathieu Othacehe +;;; +;;; 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 . + +(define-module (gnu installer newt locale) + #:use-module (gnu installer locale) + #:use-module (gnu installer steps) + #:use-module (gnu installer newt page) + #:use-module (guix i18n) + #:use-module (newt) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:use-module (ice-9 match) + #:export (run-locale-page)) + +(define (run-language-page languages language->text) + (let ((title (G_ "Locale language"))) + (run-listbox-selection-page + #:title title + #:info-text (G_ "Choose the locale's language to be used for the \ +installation process. A locale is a regional variant of your language \ +encompassing number, date and currency format, among other details. + +Based on the language you choose, you will possibly be asked to \ +select a locale's territory, codeset and modifier in the next \ +steps. The locale will also be used as the default one for the \ +installed system.") + #:info-textbox-width 70 + #:listbox-items languages + #:listbox-item->text language->text + #:sort-listbox-items? #f + #:button-text (G_ "Exit") + #:button-callback-procedure + (lambda _ + (raise + (condition + (&installer-step-abort))))))) + +(define (run-territory-page territories territory->text) + (let ((title (G_ "Locale location"))) + (run-listbox-selection-page + #:title title + #:info-text (G_ "Choose your locale's location. This is a shortlist of \ +locations based on the language you selected.") + #:listbox-items territories + #:listbox-item->text territory->text + #:button-text (G_ "Back") + #:button-callback-procedure + (lambda _ + (raise + (condition + (&installer-step-abort))))))) + +(define (run-codeset-page codesets) + (let ((title (G_ "Locale codeset"))) + (run-listbox-selection-page + #:title title + #:info-text (G_ "Choose your locale's codeset. If UTF-8 is available, \ + it should be preferred.") + #:listbox-items codesets + #:listbox-item->text identity + #:listbox-default-item "UTF-8" + #:button-text (G_ "Back") + #:button-callback-procedure + (lambda _ + (raise + (condition + (&installer-step-abort))))))) + +(define (run-modifier-page modifiers modifier->text) + (let ((title (G_ "Locale modifier"))) + (run-listbox-selection-page + #:title title + #:info-text (G_ "Choose your locale's modifier. The most frequent \ +modifier is euro. It indicates that you want to use Euro as the currency \ +symbol.") + #:listbox-items modifiers + #:listbox-item->text modifier->text + #:button-text (G_ "Back") + #:button-callback-procedure + (lambda _ + (raise + (condition + (&installer-step-abort))))))) + +(define* (run-locale-page #:key + supported-locales + iso639-languages + iso3166-territories) + "Run a page asking the user to select a locale language and possibly +territory, codeset and modifier. Use SUPPORTED-LOCALES as the list of glibc +available locales. ISO639-LANGUAGES is an association list associating a +locale code to a locale name. ISO3166-TERRITORIES is an association list +associating a territory code with a territory name. The formated locale, under +glibc format is returned." + + (define (break-on-locale-found locales) + "Raise the &installer-step-break condition if LOCALES contains exactly one +element." + (and (= (length locales) 1) + (raise + (condition (&installer-step-break))))) + + (define (filter-locales locales result) + "Filter the list of locale records LOCALES using the RESULT returned by +the installer-steps defined below." + (filter + (lambda (locale) + (and-map identity + `(,(string=? (locale-language locale) + (result-step result 'language)) + ,@(if (result-step-done? result 'territory) + (list (equal? (locale-territory locale) + (result-step result 'territory))) + '()) + ,@(if (result-step-done? result 'codeset) + (list (equal? (locale-codeset locale) + (result-step result 'codeset))) + '()) + ,@(if (result-step-done? result 'modifier) + (list (equal? (locale-modifier locale) + (result-step result 'modifier))) + '())))) + locales)) + + (define (result->locale-string locales result) + "Supposing that LOCALES contains exactly one locale record, turn it into a +glibc locale string and return it." + (match (filter-locales locales result) + ((locale) + (locale->locale-string locale)))) + + (define (sort-languages languages) + "Extract some languages from LANGUAGES list and place them ahead." + (let* ((first-languages '("en")) + (other-languages (lset-difference equal? + languages + first-languages))) + `(,@first-languages ,@other-languages))) + + (define locale-steps + (list + (installer-step + (id 'language) + (compute + (lambda _ + (run-language-page + (sort-languages + (delete-duplicates (map locale-language supported-locales))) + (cut language-code->language-name iso639-languages <>))))) + (installer-step + (id 'territory) + (compute + (lambda (result _) + (let ((locales (filter-locales supported-locales result))) + ;; Stop the process if the language returned by the previous step + ;; is matching one and only one supported locale. + (break-on-locale-found locales) + + ;; Otherwise, ask the user to select a territory among those + ;; supported by the previously selected language. + (run-territory-page + (delete-duplicates (map locale-territory locales)) + (lambda (territory-code) + (if territory-code + (territory-code->territory-name iso3166-territories + territory-code) + (G_ "No location")))))))) + (installer-step + (id 'codeset) + (compute + (lambda (result _) + (let ((locales (filter-locales supported-locales result))) + ;; Same as above but we now have a language and a territory to + ;; narrow down the search of a locale. + (break-on-locale-found locales) + + ;; Otherwise, ask for a codeset. + (run-codeset-page + (delete-duplicates (map locale-codeset locales))))))) + (installer-step + (id 'modifier) + (compute + (lambda (result _) + (let ((locales (filter-locales supported-locales result))) + ;; Same thing with a language, a territory and a codeset this time. + (break-on-locale-found locales) + + ;; Otherwise, ask for a modifier. + (run-modifier-page + (delete-duplicates (map locale-modifier locales)) + (lambda (modifier) + (or modifier (G_ "No modifier")))))))))) + + ;; If run-installer-steps returns locally, it means that the user had to go + ;; through all steps (language, territory, codeset and modifier) to select a + ;; locale. In that case, like if we exited by raising &installer-step-break + ;; condition, turn the result into a glibc locale string and return it. + (result->locale-string + supported-locales + (run-installer-steps #:steps locale-steps))) diff --git a/gnu/installer/newt/menu.scm b/gnu/installer/newt/menu.scm new file mode 100644 index 0000000000..161266a94a --- /dev/null +++ b/gnu/installer/newt/menu.scm @@ -0,0 +1,44 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Mathieu Othacehe +;;; +;;; 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 . + +(define-module (gnu installer newt menu) + #:use-module (gnu installer steps) + #:use-module (gnu installer newt page) + #:use-module (guix i18n) + #:use-module (newt) + #:export (run-menu-page)) + +(define (run-menu-page steps) + "Run a menu page, asking the user to select where to resume the install +process from." + (define (steps->items steps) + (filter (lambda (step) + (installer-step-description step)) + steps)) + + (run-listbox-selection-page + #:info-text (G_ "Choose where you want to resume the install.\ +You can also abort the installation by pressing the Abort button.") + #:title (G_ "Installation menu") + #:listbox-items (steps->items steps) + #:listbox-item->text installer-step-description + #:sort-listbox-items? #f + #:button-text (G_ "Abort") + #:button-callback-procedure (lambda () + (newt-finish) + (primitive-exit 1)))) diff --git a/gnu/installer/newt/network.scm b/gnu/installer/newt/network.scm new file mode 100644 index 0000000000..f263b7df9d --- /dev/null +++ b/gnu/installer/newt/network.scm @@ -0,0 +1,173 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Mathieu Othacehe +;;; +;;; 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 . + +(define-module (gnu installer newt network) + #:use-module (gnu installer connman) + #:use-module (gnu installer steps) + #:use-module (gnu installer utils) + #:use-module (gnu installer newt ethernet) + #:use-module (gnu installer newt page) + #:use-module (gnu installer newt wifi) + #:use-module (guix i18n) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:use-module (newt) + #:export (run-network-page)) + +;; Maximum length of a technology name. +(define technology-name-max-length (make-parameter 20)) + +(define (technology->text technology) + "Return a string describing the given TECHNOLOGY." + (let* ((name (technology-name technology)) + (padded-name (string-pad-right name + (technology-name-max-length)))) + (format #f "~a~%" padded-name))) + +(define (run-technology-page) + "Run a page to ask the user which technology shall be used to access +Internet and return the selected technology. For now, only technologies with +\"ethernet\" or \"wifi\" types are supported." + (define (technology-items) + (filter (lambda (technology) + (let ((type (technology-type technology))) + (or + (string=? type "ethernet") + (string=? type "wifi")))) + (connman-technologies))) + + (let ((items (technology-items))) + (if (null? items) + (case (choice-window + (G_ "Internet access") + (G_ "Continue") + (G_ "Exit") + (G_ "The install process requires an internet access, but no \ +network device were found. Do you want to continue anyway?")) + ((1) (raise + (condition + (&installer-step-break)))) + ((2) (raise + (condition + (&installer-step-abort))))) + (run-listbox-selection-page + #:info-text (G_ "The install process requires an internet access.\ + Please select a network device.") + #:title (G_ "Internet access") + #:listbox-items items + #:listbox-item->text technology->text + #:button-text (G_ "Exit") + #:button-callback-procedure + (lambda _ + (raise + (condition + (&installer-step-abort)))))))) + +(define (find-technology-by-type technologies type) + "Find and return a technology with the given TYPE in TECHNOLOGIES list." + (find (lambda (technology) + (string=? (technology-type technology) + type)) + technologies)) + +(define (wait-technology-powered technology) + "Wait and display a progress bar until the given TECHNOLOGY is powered." + (let ((name (technology-name technology)) + (full-value 5)) + (run-scale-page + #:title (G_ "Powering technology") + #:info-text (format #f "Waiting for technology ~a to be powered." name) + #:scale-full-value full-value + #:scale-update-proc + (lambda (value) + (let* ((technologies (connman-technologies)) + (type (technology-type technology)) + (updated-technology + (find-technology-by-type technologies type)) + (technology-powered? updated-technology)) + (sleep 1) + (if technology-powered? + full-value + (+ value 1))))))) + +(define (wait-service-online) + "Display a newt scale until connman detects an Internet access. Do +FULL-VALUE tentatives, spaced by 1 second." + (let* ((full-value 5)) + (run-scale-page + #:title (G_ "Checking connectivity") + #:info-text (G_ "Waiting internet access is established.") + #:scale-full-value full-value + #:scale-update-proc + (lambda (value) + (sleep 1) + (if (connman-online?) + full-value + (+ value 1)))) + (unless (connman-online?) + (run-error-page + (G_ "The selected network does not provide an Internet \ +access, please try again.") + (G_ "Connection error")) + (raise + (condition + (&installer-step-abort)))))) + +(define (run-network-page) + "Run a page to allow the user to configure connman so that it can access the +Internet." + (define network-steps + (list + ;; Ask the user to choose between ethernet and wifi technologies. + (installer-step + (id 'select-technology) + (compute + (lambda _ + (run-technology-page)))) + ;; Enable the previously selected technology. + (installer-step + (id 'power-technology) + (compute + (lambda (result _) + (let ((technology (result-step result 'select-technology))) + (connman-enable-technology technology) + (wait-technology-powered technology))))) + ;; Propose the user to connect to one of the service available for the + ;; previously selected technology. + (installer-step + (id 'connect-service) + (compute + (lambda (result _) + (let* ((technology (result-step result 'select-technology)) + (type (technology-type technology))) + (cond + ((string=? "wifi" type) + (run-wifi-page)) + ((string=? "ethernet" type) + (run-ethernet-page))))))) + ;; Wait for connman status to switch to 'online, which means it can + ;; access Internet. + (installer-step + (id 'wait-online) + (compute (lambda _ + (wait-service-online)))))) + (run-installer-steps + #:steps network-steps + #:rewind-strategy 'start)) diff --git a/gnu/installer/newt/page.scm b/gnu/installer/newt/page.scm new file mode 100644 index 0000000000..edf0b8c999 --- /dev/null +++ b/gnu/installer/newt/page.scm @@ -0,0 +1,530 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Mathieu Othacehe +;;; +;;; 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 . + +(define-module (gnu installer newt page) + #:use-module (gnu installer utils) + #:use-module (gnu installer newt utils) + #:use-module (guix i18n) + #:use-module (ice-9 match) + #:use-module (ice-9 receive) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (newt) + #:export (draw-info-page + draw-connecting-page + run-input-page + run-error-page + run-listbox-selection-page + run-scale-page + run-checkbox-tree-page + run-file-textbox-page)) + +;;; Commentary: +;;; +;;; Some helpers around guile-newt to draw or run generic pages. The +;;; difference between 'draw' and 'run' terms comes from newt library. A page +;;; is drawn when the form it contains does not expect any user +;;; interaction. In that case, it is necessary to call (newt-refresh) to force +;;; the page to be displayed. When a form is 'run', it is blocked waiting for +;;; any action from the user (press a button, input some text, ...). +;;; +;;; Code: + +(define (draw-info-page text title) + "Draw an informative page with the given TEXT as content. Set the title of +this page to TITLE." + (let* ((text-box + (make-reflowed-textbox -1 -1 text 40 + #:flags FLAG-BORDER)) + (grid (make-grid 1 1)) + (form (make-form))) + (set-grid-field grid 0 0 GRID-ELEMENT-COMPONENT text-box) + (add-component-to-form form text-box) + (make-wrapped-grid-window grid title) + (draw-form form) + ;; This call is imperative, otherwise the form won't be displayed. See the + ;; explanation in the above commentary. + (newt-refresh) + form)) + +(define (draw-connecting-page service-name) + "Draw a page to indicate a connection in in progress." + (draw-info-page + (format #f (G_ "Connecting to ~a, please wait.") service-name) + (G_ "Connection in progress"))) + +(define* (run-input-page text title + #:key + (allow-empty-input? #f) + (default-text #f) + (input-field-width 40)) + "Run a page to prompt user for an input. The given TEXT will be displayed +above the input field. The page title is set to TITLE. Unless +allow-empty-input? is set to #t, an error page will be displayed if the user +enters an empty input." + (let* ((text-box + (make-reflowed-textbox -1 -1 text + input-field-width + #:flags FLAG-BORDER)) + (grid (make-grid 1 3)) + (input-entry (make-entry -1 -1 20)) + (ok-button (make-button -1 -1 (G_ "OK"))) + (form (make-form))) + + (when default-text + (set-entry-text input-entry default-text)) + + (set-grid-field grid 0 0 GRID-ELEMENT-COMPONENT text-box) + (set-grid-field grid 0 1 GRID-ELEMENT-COMPONENT input-entry + #:pad-top 1) + (set-grid-field grid 0 2 GRID-ELEMENT-COMPONENT ok-button + #:pad-top 1) + + (add-components-to-form form text-box input-entry ok-button) + (make-wrapped-grid-window grid title) + (let ((error-page (lambda () + (run-error-page (G_ "Please enter a non empty input.") + (G_ "Empty input"))))) + (let loop () + (receive (exit-reason argument) + (run-form form) + (let ((input (entry-value input-entry))) + (if (and (not allow-empty-input?) + (eq? exit-reason 'exit-component) + (string=? input "")) + (begin + ;; Display the error page. + (error-page) + ;; Set the focus back to the input input field. + (set-current-component form input-entry) + (loop)) + (begin + (destroy-form-and-pop form) + input)))))))) + +(define (run-error-page text title) + "Run a page to inform the user of an error. The page contains the given TEXT +to explain the error and an \"OK\" button to acknowledge the error. The title +of the page is set to TITLE." + (let* ((text-box + (make-reflowed-textbox -1 -1 text 40 + #:flags FLAG-BORDER)) + (grid (make-grid 1 2)) + (ok-button (make-button -1 -1 "OK")) + (form (make-form))) + + (set-grid-field grid 0 0 GRID-ELEMENT-COMPONENT text-box) + (set-grid-field grid 0 1 GRID-ELEMENT-COMPONENT ok-button + #:pad-top 1) + + ;; Set the background color to red to indicate something went wrong. + (newt-set-color COLORSET-ROOT "white" "red") + (add-components-to-form form text-box ok-button) + (make-wrapped-grid-window grid title) + (run-form form) + ;; Restore the background to its original color. + (newt-set-color COLORSET-ROOT "white" "blue") + (destroy-form-and-pop form))) + +(define* (run-listbox-selection-page #:key + info-text + title + (info-textbox-width 50) + listbox-items + listbox-item->text + (listbox-height 20) + (listbox-default-item #f) + (listbox-allow-multiple? #f) + (sort-listbox-items? #t) + (allow-delete? #f) + (skip-item-procedure? + (const #f)) + button-text + (button-callback-procedure + (const #t)) + (button2-text #f) + (button2-callback-procedure + (const #t)) + (listbox-callback-procedure + identity) + (hotkey-callback-procedure + (const #t))) + "Run a page asking the user to select an item in a listbox. The page +contains, stacked vertically from the top to the bottom, an informative text +set to INFO-TEXT, a listbox and a button. The listbox will be filled with +LISTBOX-ITEMS converted to text by applying the procedure LISTBOX-ITEM->TEXT +on every item. The selected item from LISTBOX-ITEMS is returned. The button +text is set to BUTTON-TEXT and the procedure BUTTON-CALLBACK-PROCEDURE called +when it is pressed. The procedure LISTBOX-CALLBACK-PROCEDURE is called when an +item from the listbox is selected (by pressing the key). + +INFO-TEXTBOX-WIDTH is the width of the textbox where INFO-TEXT will be +displayed. LISTBOX-HEIGHT is the height of the listbox. + +If LISTBOX-DEFAULT-ITEM is set to the value of one of the items in +LISTBOX-ITEMS, it will be selected by default. Otherwise, the first element of +the listbox is selected. + +If LISTBOX-ALLOW-MULTIPLE? is set to #t, multiple items from the listbox can +be selected (using the key). It that case, a list containing the +selected items will be returned. + +If SORT-LISTBOX-ITEMS? is set to #t, the listbox items are sorted using +'string<=' procedure (after being converted to text). + +If ALLOW-DELETE? is #t, the form will return if the key is pressed, +otherwise nothing will happend. + +Each time the listbox current item changes, call SKIP-ITEM-PROCEDURE? with the +current listbox item as argument. If it returns #t, skip the element and jump +to the next/previous one depending on the previous item, otherwise do +nothing." + + (define (fill-listbox listbox items) + "Append the given ITEMS to LISTBOX, once they have been converted to text +with LISTBOX-ITEM->TEXT. Each item appended to the LISTBOX is given a key by +newt. Save this key by returning an association list under the form: + + ((NEWT-LISTBOX-KEY . ITEM) ...) + +where NEWT-LISTBOX-KEY is the key returned by APPEND-ENTRY-TO-LISTBOX, when +ITEM was inserted into LISTBOX." + (map (lambda (item) + (let* ((text (listbox-item->text item)) + (key (append-entry-to-listbox listbox text))) + (cons key item))) + items)) + + (define (sort-listbox-items listbox-items) + "Return LISTBOX-ITEMS sorted using the 'string<=' procedure on the text +corresponding to each item in the list." + (let* ((items (map (lambda (item) + (cons item (listbox-item->text item))) + listbox-items)) + (sorted-items + (sort items (lambda (a b) + (let ((text-a (cdr a)) + (text-b (cdr b))) + (string<= text-a text-b)))))) + (map car sorted-items))) + + ;; Store the last selected listbox item's key. + (define last-listbox-key (make-parameter #f)) + + (define (previous-key keys key) + (let ((index (list-index (cut eq? key <>) keys))) + (and index + (> index 0) + (list-ref keys (- index 1))))) + + (define (next-key keys key) + (let ((index (list-index (cut eq? key <>) keys))) + (and index + (< index (- (length keys) 1)) + (list-ref keys (+ index 1))))) + + (define (set-default-item listbox listbox-keys default-item) + "Set the default item of LISTBOX to DEFAULT-ITEM. LISTBOX-KEYS is the +association list returned by the FILL-LISTBOX procedure. It is used because +the current listbox item has to be selected by key." + (for-each (match-lambda + ((key . item) + (when (equal? item default-item) + (set-current-listbox-entry-by-key listbox key)))) + listbox-keys)) + + (let* ((listbox (make-listbox + -1 -1 + listbox-height + (logior FLAG-SCROLL FLAG-BORDER FLAG-RETURNEXIT + (if listbox-allow-multiple? + FLAG-MULTIPLE + 0)))) + (form (make-form)) + (info-textbox + (make-reflowed-textbox -1 -1 info-text + info-textbox-width + #:flags FLAG-BORDER)) + (button (make-button -1 -1 button-text)) + (button2 (and button2-text + (make-button -1 -1 button2-text))) + (grid (vertically-stacked-grid + GRID-ELEMENT-COMPONENT info-textbox + GRID-ELEMENT-COMPONENT listbox + GRID-ELEMENT-SUBGRID + (apply + horizontal-stacked-grid + GRID-ELEMENT-COMPONENT button + `(,@(if button2 + (list GRID-ELEMENT-COMPONENT button2) + '()))))) + (sorted-items (if sort-listbox-items? + (sort-listbox-items listbox-items) + listbox-items)) + (keys (fill-listbox listbox sorted-items))) + + ;; On every listbox element change, check if we need to skip it. If yes, + ;; depending on the 'last-listbox-key', jump forward or backward. If no, + ;; do nothing. + (add-component-callback + listbox + (lambda (component) + (let* ((current-key (current-listbox-entry listbox)) + (listbox-keys (map car keys)) + (last-key (last-listbox-key)) + (item (assoc-ref keys current-key)) + (prev-key (previous-key listbox-keys current-key)) + (next-key (next-key listbox-keys current-key))) + ;; Update last-listbox-key before a potential call to + ;; set-current-listbox-entry-by-key, because it will immediately + ;; cause this callback to be called for the new entry. + (last-listbox-key current-key) + (when (skip-item-procedure? item) + (when (eq? prev-key last-key) + (if next-key + (set-current-listbox-entry-by-key listbox next-key) + (set-current-listbox-entry-by-key listbox prev-key))) + (when (eq? next-key last-key) + (if prev-key + (set-current-listbox-entry-by-key listbox prev-key) + (set-current-listbox-entry-by-key listbox next-key))))))) + + (when listbox-default-item + (set-default-item listbox keys listbox-default-item)) + + (when allow-delete? + (form-add-hotkey form KEY-DELETE)) + + (add-form-to-grid grid form #t) + (make-wrapped-grid-window grid title) + + (receive (exit-reason argument) + (run-form form) + (dynamic-wind + (const #t) + (lambda () + (case exit-reason + ((exit-component) + (cond + ((components=? argument button) + (button-callback-procedure)) + ((and button2 + (components=? argument button2)) + (button2-callback-procedure)) + ((components=? argument listbox) + (if listbox-allow-multiple? + (let* ((entries (listbox-selection listbox)) + (items (map (lambda (entry) + (assoc-ref keys entry)) + entries))) + (listbox-callback-procedure items)) + (let* ((entry (current-listbox-entry listbox)) + (item (assoc-ref keys entry))) + (listbox-callback-procedure item)))))) + ((exit-hotkey) + (let* ((entry (current-listbox-entry listbox)) + (item (assoc-ref keys entry))) + (hotkey-callback-procedure argument item))))) + (lambda () + (destroy-form-and-pop form)))))) + +(define* (run-scale-page #:key + title + info-text + (info-textbox-width 50) + (scale-width 40) + (scale-full-value 100) + scale-update-proc + (max-scale-update 5)) + "Run a page with a progress bar (called 'scale' in newt). The given +INFO-TEXT is displayed in a textbox above the scale. The width of the textbox +is set to INFO-TEXTBOX-WIDTH. The width of the scale is set to +SCALE-WIDTH. SCALE-FULL-VALUE indicates the value that correspond to 100% of +the scale. + +The procedure SCALE-UPDATE-PROC shall return a new scale +value. SCALE-UPDATE-PROC will be called until the returned value is superior +or equal to SCALE-FULL-VALUE, but no more than MAX-SCALE-UPDATE times. An +error is raised if the MAX-SCALE-UPDATE limit is reached." + (let* ((info-textbox + (make-reflowed-textbox -1 -1 info-text + info-textbox-width + #:flags FLAG-BORDER)) + (scale (make-scale -1 -1 scale-width scale-full-value)) + (grid (vertically-stacked-grid + GRID-ELEMENT-COMPONENT info-textbox + GRID-ELEMENT-COMPONENT scale)) + (form (make-form))) + + (add-form-to-grid grid form #t) + (make-wrapped-grid-window grid title) + + (draw-form form) + ;; This call is imperative, otherwise the form won't be displayed. See the + ;; explanation in the above commentary. + (newt-refresh) + + (dynamic-wind + (const #t) + (lambda () + (let loop ((i max-scale-update) + (last-value 0)) + (let ((value (scale-update-proc last-value))) + (set-scale-value scale value) + ;; Same as above. + (newt-refresh) + (unless (>= value scale-full-value) + (if (> i 0) + (loop (- i 1) value) + (error "Max scale updates reached.")))))) + (lambda () + (destroy-form-and-pop form))))) + +(define* (run-checkbox-tree-page #:key + info-text + title + items + item->text + (info-textbox-width 50) + (checkbox-tree-height 10) + (ok-button-callback-procedure + (const #t)) + (exit-button-callback-procedure + (const #t))) + "Run a page allowing the user to select one or multiple items among ITEMS in +a checkbox list. The page contains vertically stacked from the top to the +bottom, an informative text set to INFO-TEXT, the checkbox list and two +buttons, 'Ok' and 'Exit'. The page title's is set to TITLE. ITEMS are +converted to text using ITEM->TEXT before being displayed in the checkbox +list. + +INFO-TEXTBOX-WIDTH is the width of the textbox where INFO-TEXT will be +displayed. CHECKBOX-TREE-HEIGHT is the height of the checkbox list. + +OK-BUTTON-CALLBACK-PROCEDURE is called when the 'Ok' button is pressed. +EXIT-BUTTON-CALLBACK-PROCEDURE is called when the 'Exit' button is +pressed. + +This procedure returns the list of checked items in the checkbox list among +ITEMS when 'Ok' is pressed." + (define (fill-checkbox-tree checkbox-tree items) + (map + (lambda (item) + (let* ((item-text (item->text item)) + (key (add-entry-to-checkboxtree checkbox-tree item-text 0))) + (cons key item))) + items)) + + (let* ((checkbox-tree + (make-checkboxtree -1 -1 + checkbox-tree-height + FLAG-BORDER)) + (info-textbox + (make-reflowed-textbox -1 -1 info-text + info-textbox-width + #:flags FLAG-BORDER)) + (ok-button (make-button -1 -1 (G_ "OK"))) + (exit-button (make-button -1 -1 (G_ "Exit"))) + (grid (vertically-stacked-grid + GRID-ELEMENT-COMPONENT info-textbox + GRID-ELEMENT-COMPONENT checkbox-tree + GRID-ELEMENT-SUBGRID + (horizontal-stacked-grid + GRID-ELEMENT-COMPONENT ok-button + GRID-ELEMENT-COMPONENT exit-button))) + (keys (fill-checkbox-tree checkbox-tree items)) + (form (make-form))) + + (add-form-to-grid grid form #t) + (make-wrapped-grid-window grid title) + + (receive (exit-reason argument) + (run-form form) + (dynamic-wind + (const #t) + (lambda () + (case exit-reason + ((exit-component) + (cond + ((components=? argument ok-button) + (let* ((entries (current-checkbox-selection checkbox-tree)) + (current-items (map (lambda (entry) + (assoc-ref keys entry)) + entries))) + (ok-button-callback-procedure) + current-items)) + ((components=? argument exit-button) + (exit-button-callback-procedure)))))) + (lambda () + (destroy-form-and-pop form)))))) + +(define* (run-file-textbox-page #:key + info-text + title + file + (info-textbox-width 50) + (file-textbox-width 50) + (file-textbox-height 30) + (exit-button? #t) + (ok-button-callback-procedure + (const #t)) + (exit-button-callback-procedure + (const #t))) + (let* ((info-textbox + (make-reflowed-textbox -1 -1 info-text + info-textbox-width + #:flags FLAG-BORDER)) + (file-text (read-all file)) + (file-textbox + (make-textbox -1 -1 + file-textbox-width + file-textbox-height + (logior FLAG-SCROLL FLAG-BORDER))) + (ok-button (make-button -1 -1 (G_ "OK"))) + (exit-button (make-button -1 -1 (G_ "Exit"))) + (grid (vertically-stacked-grid + GRID-ELEMENT-COMPONENT info-textbox + GRID-ELEMENT-COMPONENT file-textbox + GRID-ELEMENT-SUBGRID + (apply + horizontal-stacked-grid + GRID-ELEMENT-COMPONENT ok-button + `(,@(if exit-button? + (list GRID-ELEMENT-COMPONENT exit-button) + '()))))) + (form (make-form))) + + (set-textbox-text file-textbox file-text) + (add-form-to-grid grid form #t) + (make-wrapped-grid-window grid title) + + (receive (exit-reason argument) + (run-form form) + (dynamic-wind + (const #t) + (lambda () + (case exit-reason + ((exit-component) + (cond + ((components=? argument ok-button) + (ok-button-callback-procedure)) + ((and exit-button? + (components=? argument exit-button)) + (exit-button-callback-procedure)))))) + (lambda () + (destroy-form-and-pop form)))))) diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm new file mode 100644 index 0000000000..d4c91edc66 --- /dev/null +++ b/gnu/installer/newt/partition.scm @@ -0,0 +1,766 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Mathieu Othacehe +;;; +;;; 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 . + +(define-module (gnu installer newt partition) + #:use-module (gnu installer parted) + #:use-module (gnu installer steps) + #:use-module (gnu installer utils) + #:use-module (gnu installer newt page) + #:use-module (gnu installer newt utils) + #:use-module (guix i18n) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:use-module (newt) + #:use-module (parted) + #:export (run-partioning-page)) + +(define (button-exit-action) + "Raise the &installer-step-abort condition." + (raise + (condition + (&installer-step-abort)))) + +(define (run-scheme-page) + "Run a page asking the user for a partitioning scheme." + (let* ((items + '((root . "Everything is one partition") + (root-home . "Separate /home partition"))) + (result (run-listbox-selection-page + #:info-text (G_ "Please select a partitioning scheme.") + #:title (G_ "Partition scheme") + #:listbox-items items + #:listbox-item->text cdr + #:button-text (G_ "Exit") + #:button-callback-procedure button-exit-action))) + (car result))) + +(define (draw-formatting-page) + "Draw a page to indicate partitions are being formated." + (draw-info-page + (format #f (G_ "Partition formatting is in progress, please wait.")) + (G_ "Preparing partitions"))) + +(define (run-device-page devices) + "Run a page asking the user to select a device among those in the given +DEVICES list." + (define (device-items) + (map (lambda (device) + `(,device . ,(device-description device))) + devices)) + + (let* ((result (run-listbox-selection-page + #:info-text (G_ "Please select a disk.") + #:title (G_ "Disk") + #:listbox-items (device-items) + #:listbox-item->text cdr + #:button-text (G_ "Exit") + #:button-callback-procedure button-exit-action)) + (device (car result))) + device)) + +(define (run-label-page button-text button-callback) + "Run a page asking the user to select a partition table label." + (run-listbox-selection-page + #:info-text (G_ "Select a new partition table type. \ +Be careful, all data on the disk will be lost.") + #:title (G_ "Partition table") + #:listbox-items '("msdos" "gpt") + #:listbox-item->text identity + #:button-text button-text + #:button-callback-procedure button-callback)) + +(define (run-type-page partition) + "Run a page asking the user to select a partition type." + (let* ((disk (partition-disk partition)) + (partitions (disk-partitions disk)) + (other-extended-partitions? + (any extended-partition? partitions)) + (items + `(normal ,@(if other-extended-partitions? + '() + '(extended))))) + (run-listbox-selection-page + #:info-text (G_ "Please select a partition type.") + #:title (G_ "Partition type") + #:listbox-items items + #:listbox-item->text symbol->string + #:sort-listbox-items? #f + #:button-text (G_ "Exit") + #:button-callback-procedure button-exit-action))) + +(define (run-fs-type-page) + "Run a page asking the user to select a file-system type." + (run-listbox-selection-page + #:info-text (G_ "Please select the file-system type for this partition.") + #:title (G_ "File-system type") + #:listbox-items '(ext4 btrfs fat32 swap) + #:listbox-item->text user-fs-type-name + #:sort-listbox-items? #f + #:button-text (G_ "Exit") + #:button-callback-procedure button-exit-action)) + +(define (inform-can-create-partition? user-partition) + "Return #t if it is possible to create USER-PARTITION. This is determined by +calling CAN-CREATE-PARTITION? procedure. If an exception is raised, catch it +an inform the user with an appropriate error-page and return #f." + (guard (c ((max-primary-exceeded? c) + (run-error-page + (G_ "Primary partitions count exceeded.") + (G_ "Creation error")) + #f) + ((extended-creation-error? c) + (run-error-page + (G_ "Extended partition creation error.") + (G_ "Creation error")) + #f) + ((logical-creation-error? c) + (run-error-page + (G_ "Logical partition creation error.") + (G_ "Creation error")) + #f)) + (can-create-partition? user-partition))) + +(define (prompt-luks-passwords user-partitions) + "Prompt for the luks passwords of the encrypted partitions in +USER-PARTITIONS list. Return this list with password fields filled-in." + (map (lambda (user-part) + (let* ((crypt-label (user-partition-crypt-label user-part)) + (file-name (user-partition-file-name user-part)) + (password-page + (lambda () + (run-input-page + (format #f (G_ "Please enter the password for the \ +encryption of partition ~a (label: ~a).") file-name crypt-label) + (G_ "Password required")))) + (password-confirm-page + (lambda () + (run-input-page + (format #f (G_ "Please confirm the password for the \ +encryption of partition ~a (label: ~a).") file-name crypt-label) + (G_ "Password confirmation required"))))) + (if crypt-label + (let loop () + (let ((password (password-page)) + (confirmation (password-confirm-page))) + (if (string=? password confirmation) + (user-partition + (inherit user-part) + (crypt-password password)) + (begin + (run-error-page + (G_ "Password mismatch, please try again.") + (G_ "Password error")) + (loop))))) + user-part))) + user-partitions)) + +(define* (run-partition-page target-user-partition + #:key + (default-item #f)) + "Run a page allowing the user to edit the given TARGET-USER-PARTITION +record. If the argument DEFAULT-ITEM is passed, use it to select the current +listbox item. This is used to avoid the focus to switch back to the first +listbox entry while calling this procedure recursively." + + (define (numeric-size device size) + "Parse the given SIZE on DEVICE and return it." + (call-with-values + (lambda () + (unit-parse size device)) + (lambda (value range) + value))) + + (define (numeric-size-range device size) + "Parse the given SIZE on DEVICE and return the associated RANGE." + (call-with-values + (lambda () + (unit-parse size device)) + (lambda (value range) + range))) + + (define* (fill-user-partition-geom user-part + #:key + device (size #f) start end) + "Return the given USER-PART with the START, END and SIZE fields set to the +eponym arguments. Use UNIT-FORMAT-CUSTOM to format START and END arguments as +sectors on DEVICE." + (user-partition + (inherit user-part) + (size size) + (start (unit-format-custom device start UNIT-SECTOR)) + (end (unit-format-custom device end UNIT-SECTOR)))) + + (define (apply-user-partition-changes user-part) + "Set the name, file-system type and boot flag on the partition specified +by USER-PART, if it is applicable for the partition type." + (let* ((partition (user-partition-parted-object user-part)) + (disk (partition-disk partition)) + (disk-type (disk-disk-type disk)) + (device (disk-device disk)) + (has-name? (disk-type-check-feature + disk-type + DISK-TYPE-FEATURE-PARTITION-NAME)) + (name (user-partition-name user-part)) + (fs-type (filesystem-type-get + (user-fs-type-name + (user-partition-fs-type user-part)))) + (bootable? (user-partition-bootable? user-part)) + (esp? (user-partition-esp? user-part)) + (flag-bootable? + (partition-is-flag-available? partition PARTITION-FLAG-BOOT)) + (flag-esp? + (partition-is-flag-available? partition PARTITION-FLAG-ESP))) + (when (and has-name? name) + (partition-set-name partition name)) + (partition-set-system partition fs-type) + (when flag-bootable? + (partition-set-flag partition + PARTITION-FLAG-BOOT + (if bootable? 1 0))) + (when flag-esp? + (partition-set-flag partition + PARTITION-FLAG-ESP + (if esp? 1 0))) + #t)) + + (define (listbox-action listbox-item) + (let* ((item (car listbox-item)) + (partition (user-partition-parted-object + target-user-partition)) + (disk (partition-disk partition)) + (device (disk-device disk))) + (list + item + (case item + ((name) + (let* ((old-name (user-partition-name target-user-partition)) + (name + (run-input-page (G_ "Please enter the partition gpt name.") + (G_ "Partition name") + #:default-text old-name))) + (user-partition + (inherit target-user-partition) + (name name)))) + ((type) + (let ((new-type (run-type-page partition))) + (user-partition + (inherit target-user-partition) + (type new-type)))) + ((bootable) + (user-partition + (inherit target-user-partition) + (bootable? (not (user-partition-bootable? + target-user-partition))))) + ((esp?) + (let ((new-esp? (not (user-partition-esp? + target-user-partition)))) + (user-partition + (inherit target-user-partition) + (esp? new-esp?) + (mount-point (if new-esp? + (default-esp-mount-point) + ""))))) + ((crypt-label) + (let* ((label (user-partition-crypt-label + target-user-partition)) + (new-label + (and (not label) + (run-input-page + (G_ "Please enter the encrypted label") + (G_ "Encryption label"))))) + (user-partition + (inherit target-user-partition) + (need-formatting? #t) + (crypt-label new-label)))) + ((need-formatting?) + (user-partition + (inherit target-user-partition) + (need-formatting? + (not (user-partition-need-formatting? + target-user-partition))))) + ((size) + (let* ((old-size (user-partition-size target-user-partition)) + (max-size-value (partition-length partition)) + (max-size (unit-format device max-size-value)) + (start (partition-start partition)) + (size (run-input-page + (format #f (G_ "Please enter the size of the partition.\ + The maximum size is ~a.") max-size) + (G_ "Partition size") + #:default-text (or old-size max-size))) + (size-percentage (read-percentage size)) + (size-value (if size-percentage + (nearest-exact-integer + (/ (* max-size-value size-percentage) + 100)) + (numeric-size device size))) + (end (and size-value + (+ start size-value))) + (size-range (numeric-size-range device size)) + (size-range-ok? (and size-range + (< (+ start + (geometry-start size-range)) + (partition-end partition))))) + (cond + ((and size-percentage (> size-percentage 100)) + (run-error-page + (G_ "The percentage can not be superior to 100.") + (G_ "Size error")) + target-user-partition) + ((not size-value) + (run-error-page + (G_ "The requested size is incorrectly formatted, or too large.") + (G_ "Size error")) + target-user-partition) + ((not (or size-percentage size-range-ok?)) + (run-error-page + (G_ "The request size is superior to the maximum size.") + (G_ "Size error")) + target-user-partition) + (else + (fill-user-partition-geom target-user-partition + #:device device + #:size size + #:start start + #:end end))))) + ((fs-type) + (let ((fs-type (run-fs-type-page))) + (user-partition + (inherit target-user-partition) + (fs-type fs-type)))) + ((mount-point) + (let* ((old-mount (or (user-partition-mount-point + target-user-partition) + "")) + (mount + (run-input-page + (G_ "Please enter the desired mounting point for this \ +partition. Leave this field empty if you don't want to set a mounting point.") + (G_ "Mounting point") + #:default-text old-mount + #:allow-empty-input? #t))) + (user-partition + (inherit target-user-partition) + (mount-point (and (not (string=? mount "")) + mount))))))))) + + (define (button-action) + (let* ((partition (user-partition-parted-object + target-user-partition)) + (prev-part (partition-prev partition)) + (disk (partition-disk partition)) + (device (disk-device disk)) + (creation? (freespace-partition? partition)) + (start (partition-start partition)) + (end (partition-end partition)) + (new-user-partition + (if (user-partition-start target-user-partition) + target-user-partition + (fill-user-partition-geom target-user-partition + #:device device + #:start start + #:end end)))) + ;; It the backend PARTITION has free-space type, it means we are + ;; creating a new partition, otherwise, we are editing an already + ;; existing PARTITION. + (if creation? + (let* ((ok-create-partition? + (inform-can-create-partition? new-user-partition)) + (new-partition + (and ok-create-partition? + (mkpart disk + new-user-partition + #:previous-partition prev-part)))) + (and new-partition + (user-partition + (inherit new-user-partition) + (need-formatting? #t) + (file-name (partition-get-path new-partition)) + (disk-file-name (device-path device)) + (parted-object new-partition)))) + (and (apply-user-partition-changes new-user-partition) + new-user-partition)))) + + (let* ((items (user-partition-description target-user-partition)) + (partition (user-partition-parted-object + target-user-partition)) + (disk (partition-disk partition)) + (device (disk-device disk)) + (file-name (device-path device)) + (number-str (partition-print-number partition)) + (type (user-partition-type target-user-partition)) + (type-str (symbol->string type)) + (start (unit-format device (partition-start partition))) + (creation? (freespace-partition? partition)) + (default-item (and default-item + (find (lambda (item) + (eq? (car item) default-item)) + items))) + (result + (run-listbox-selection-page + #:info-text + (if creation? + (G_ (format #f "Creating ~a partition starting at ~a of ~a." + type-str start file-name)) + (G_ (format #f "You are currently editing partition ~a." + number-str))) + #:title (if creation? + (G_ "Partition creation") + (G_ "Partition edit")) + #:listbox-items items + #:listbox-item->text cdr + #:sort-listbox-items? #f + #:listbox-default-item default-item + #:button-text (G_ "OK") + #:listbox-callback-procedure listbox-action + #:button-callback-procedure button-action))) + (match result + ((item new-user-partition) + (run-partition-page new-user-partition + #:default-item item)) + (else result)))) + +(define* (run-disk-page disks + #:optional (user-partitions '()) + #:key (guided? #f)) + "Run a page allowing to edit the partition tables of the given DISKS. If +specified, USER-PARTITIONS is a list of records associated to +the partitions on DISKS." + + (define (other-logical-partitions? partitions) + "Return #t if at least one of the partition in PARTITIONS list is a +logical partition, return #f otherwise." + (any logical-partition? partitions)) + + (define (other-non-logical-partitions? partitions) + "Return #t is at least one of the partitions in PARTITIONS list is not a +logical partition, return #f otherwise." + (let ((non-logical-partitions + (remove logical-partition? partitions))) + (or (any normal-partition? non-logical-partitions) + (any freespace-partition? non-logical-partitions)))) + + (define (add-tree-symbols partitions descriptions) + "Concatenate tree symbols to the given DESCRIPTIONS list and return +it. The PARTITIONS list is the list of partitions described in +DESCRIPTIONS. The tree symbols are used to indicate the partition's disk and +for logical partitions, the extended partition which includes them." + (match descriptions + (() '()) + ((description . rest-descriptions) + (match partitions + ((partition . rest-partitions) + (if (null? rest-descriptions) + (list (if (logical-partition? partition) + (string-append " ┗━ " description) + (string-append "┗━ " description))) + (cons (cond + ((extended-partition? partition) + (if (other-non-logical-partitions? rest-partitions) + (string-append "┣┳ " description) + (string-append "┗┳ " description))) + ((logical-partition? partition) + (if (other-logical-partitions? rest-partitions) + (if (other-non-logical-partitions? rest-partitions) + (string-append "┃┣━ " description) + (string-append " ┣━ " description)) + (if (other-non-logical-partitions? rest-partitions) + (string-append "┃┗━ " description) + (string-append " ┗━ " description)))) + (else + (string-append "┣━ " description))) + (add-tree-symbols rest-partitions + rest-descriptions)))))))) + + (define (skip-item? item) + (eq? (car item) 'skip)) + + (define (disk-items) + "Return the list of strings describing DISKS." + (let loop ((disks disks)) + (match disks + (() '()) + ((disk . rest) + (let* ((device (disk-device disk)) + (partitions (disk-partitions disk)) + (partitions* + (filter-map + (lambda (partition) + (and (not (metadata-partition? partition)) + (not (small-freespace-partition? device + partition)) + partition)) + partitions)) + (descriptions (add-tree-symbols + partitions* + (partitions-descriptions partitions* + user-partitions))) + (partition-items (map cons partitions* descriptions))) + (append + `((,disk . ,(device-description device disk)) + ,@partition-items + ,@(if (null? rest) + '() + '((skip . "")))) + (loop rest))))))) + + (define (remove-user-partition-by-partition user-partitions partition) + "Return the USER-PARTITIONS list with the record with the given PARTITION +object removed. If PARTITION is an extended partition, also remove all logical +partitions from USER-PARTITIONS." + (remove (lambda (p) + (let ((cur-partition (user-partition-parted-object p))) + (or (equal? cur-partition partition) + (and (extended-partition? partition) + (logical-partition? cur-partition))))) + user-partitions)) + + (define (remove-user-partition-by-disk user-partitions disk) + "Return the USER-PARTITIONS list with the records located +on given DISK removed." + (remove (lambda (p) + (let* ((partition (user-partition-parted-object p)) + (cur-disk (partition-disk partition))) + (equal? cur-disk disk))) + user-partitions)) + + (define (update-user-partitions user-partitions new-user-partition) + "Update or insert NEW-USER-PARTITION record in USER-PARTITIONS list +depending if one of the record in USER-PARTITIONS has the +same PARTITION object as NEW-USER-PARTITION." + (let* ((partition (user-partition-parted-object new-user-partition)) + (user-partitions* + (remove-user-partition-by-partition user-partitions + partition))) + (cons new-user-partition user-partitions*))) + + (define (button-ok-action) + "Commit the modifications to all DISKS and return #t." + (for-each (lambda (disk) + (disk-commit disk)) + disks) + #t) + + (define (listbox-action listbox-item) + "A disk or a partition has been selected. If it's a disk, ask for a label +to create a new partition table. If it is a partition, propose the user to +edit it." + (let ((item (car listbox-item))) + (cond + ((disk? item) + (let ((label (run-label-page (G_ "Back") (const #f)))) + (if label + (let* ((device (disk-device item)) + (new-disk (mklabel device label)) + (commit-new-disk (disk-commit new-disk)) + (other-disks (remove (lambda (disk) + (equal? disk item)) + disks)) + (new-user-partitions + (remove-user-partition-by-disk user-partitions item))) + (disk-destroy item) + `((disks . ,(cons new-disk other-disks)) + (user-partitions . ,new-user-partitions))) + `((disks . ,disks) + (user-partitions . ,user-partitions))))) + ((partition? item) + (let* ((partition item) + (disk (partition-disk partition)) + (device (disk-device disk)) + (existing-user-partition + (find-user-partition-by-parted-object user-partitions + partition)) + (edit-user-partition + (or existing-user-partition + (partition->user-partition partition)))) + `((disks . ,disks) + (user-partitions . ,user-partitions) + (edit-user-partition . ,edit-user-partition))))))) + + (define (hotkey-action key listbox-item) + "The DELETE key has been pressed on a disk or a partition item." + (let ((item (car listbox-item)) + (default-result + `((disks . ,disks) + (user-partitions . ,user-partitions)))) + (cond + ((disk? item) + (let* ((device (disk-device item)) + (file-name (device-path device)) + (info-text + (format #f (G_ "Are you sure you want to delete everything on disk ~a?") + file-name)) + (result (choice-window (G_ "Delete disk") + (G_ "OK") + (G_ "Exit") + info-text))) + (case result + ((1) + (disk-delete-all item) + `((disks . ,disks) + (user-partitions + . ,(remove-user-partition-by-disk user-partitions item)))) + (else + default-result)))) + ((partition? item) + (if (freespace-partition? item) + (run-error-page (G_ "You cannot delete a free space area.") + (G_ "Delete partition")) + (let* ((disk (partition-disk item)) + (number-str (partition-print-number item)) + (info-text + (format #f (G_ "Are you sure you want to delete partition ~a?") + number-str)) + (result (choice-window (G_ "Delete partition") + (G_ "OK") + (G_ "Exit") + info-text))) + (case result + ((1) + (let ((new-user-partitions + (remove-user-partition-by-partition user-partitions + item))) + (disk-delete-partition disk item) + `((disks . ,disks) + (user-partitions . ,new-user-partitions)))) + (else + default-result)))))))) + + (let* ((info-text (G_ "You can change a disk's partition table by \ +selecting it and pressing ENTER. You can also edit a partition by selecting it \ +and pressing ENTER, or remove it by pressing DELETE. To create a new \ +partition, select a free space area and press ENTER. + +At least one partition must have its mounting point set to '/'.")) + (guided-info-text (format #f (G_ "This is the proposed \ +partitioning. It is still possible to edit it or to go back to install menu \ +by pressing the Exit button.~%~%"))) + (result + (run-listbox-selection-page + #:info-text (if guided? + (string-append guided-info-text info-text) + info-text) + + #:title (if guided? + (G_ "Guided partitioning") + (G_ "Manual partitioning")) + #:info-textbox-width 70 + #:listbox-items (disk-items) + #:listbox-item->text cdr + #:sort-listbox-items? #f + #:skip-item-procedure? skip-item? + #:allow-delete? #t + #:button-text (G_ "OK") + #:button-callback-procedure button-ok-action + #:button2-text (G_ "Exit") + #:button2-callback-procedure button-exit-action + #:listbox-callback-procedure listbox-action + #:hotkey-callback-procedure hotkey-action))) + (if (eq? result #t) + (let ((user-partitions-ok? + (guard + (c ((no-root-mount-point? c) + (run-error-page + (G_ "No root mount point found.") + (G_ "Missing mount point")) + #f)) + (check-user-partitions user-partitions)))) + (if user-partitions-ok? + (begin + (for-each (cut disk-destroy <>) disks) + user-partitions) + (run-disk-page disks user-partitions + #:guided? guided?))) + (let* ((result-disks (assoc-ref result 'disks)) + (result-user-partitions (assoc-ref result + 'user-partitions)) + (edit-user-partition (assoc-ref result + 'edit-user-partition)) + (can-create-partition? + (and edit-user-partition + (inform-can-create-partition? edit-user-partition))) + (new-user-partition (and edit-user-partition + can-create-partition? + (run-partition-page + edit-user-partition))) + (new-user-partitions + (if new-user-partition + (update-user-partitions result-user-partitions + new-user-partition) + result-user-partitions))) + (run-disk-page result-disks new-user-partitions + #:guided? guided?))))) + +(define (run-partioning-page) + "Run a page asking the user for a partitioning method." + (define (run-page devices) + (let* ((items + '((entire . "Guided - using the entire disk") + (entire-encrypted . "Guided - using the entire disk with encryption") + (manual . "Manual"))) + (result (run-listbox-selection-page + #:info-text (G_ "Please select a partitioning method.") + #:title (G_ "Partitioning method") + #:listbox-items items + #:listbox-item->text cdr + #:button-text (G_ "Exit") + #:button-callback-procedure button-exit-action)) + (method (car result))) + (cond + ((or (eq? method 'entire) + (eq? method 'entire-encrypted)) + (let* ((device (run-device-page devices)) + (disk-type (disk-probe device)) + (disk (if disk-type + (disk-new device) + (let* ((label (run-label-page + (G_ "Exit") + button-exit-action)) + (disk (mklabel device label))) + (disk-commit disk) + disk))) + (scheme (symbol-append method '- (run-scheme-page))) + (user-partitions (append + (auto-partition disk #:scheme scheme) + (create-special-user-partitions + (disk-partitions disk))))) + (run-disk-page (list disk) user-partitions + #:guided? #t))) + ((eq? method 'manual) + (let* ((disks (filter-map disk-new devices)) + (user-partitions (append-map + create-special-user-partitions + (map disk-partitions disks))) + (result-user-partitions (run-disk-page disks + user-partitions))) + result-user-partitions))))) + + (init-parted) + (let* ((non-install-devices (non-install-devices)) + (user-partitions (run-page non-install-devices)) + (user-partitions-with-pass (prompt-luks-passwords + user-partitions)) + (form (draw-formatting-page))) + ;; Make sure the disks are not in use before proceeding to formatting. + (free-parted non-install-devices) + (format-user-partitions user-partitions-with-pass) + (destroy-form-and-pop form) + user-partitions)) diff --git a/gnu/installer/newt/services.scm b/gnu/installer/newt/services.scm new file mode 100644 index 0000000000..6bcb6244ae --- /dev/null +++ b/gnu/installer/newt/services.scm @@ -0,0 +1,48 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Mathieu Othacehe +;;; +;;; 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 . + +(define-module (gnu installer newt services) + #:use-module (gnu installer services) + #:use-module (gnu installer steps) + #:use-module (gnu installer newt page) + #:use-module (gnu installer newt utils) + #:use-module (guix i18n) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:use-module (newt) + #:export (run-services-page)) + +(define (run-desktop-environments-cbt-page) + "Run a page allowing the user to choose between various desktop +environments." + (run-checkbox-tree-page + #:info-text (G_ "Please select the desktop(s) environment(s) you wish to \ +install. If you select multiple desktops environments, we will be able to \ +choose the one to use on the log-in screen with F1.") + #:title (G_ "Desktop environment") + #:items %desktop-environments + #:item->text desktop-environment-name + #:checkbox-tree-height 5 + #:exit-button-callback-procedure + (lambda () + (raise + (condition + (&installer-step-abort)))))) + +(define (run-services-page) + (run-desktop-environments-cbt-page)) diff --git a/gnu/installer/newt/timezone.scm b/gnu/installer/newt/timezone.scm new file mode 100644 index 0000000000..6c96ee55b1 --- /dev/null +++ b/gnu/installer/newt/timezone.scm @@ -0,0 +1,83 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Mathieu Othacehe +;;; +;;; 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 . + +(define-module (gnu installer newt timezone) + #:use-module (gnu installer steps) + #:use-module (gnu installer timezone) + #:use-module (gnu installer newt page) + #:use-module (guix i18n) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:use-module (ice-9 match) + #:use-module (ice-9 receive) + #:use-module (newt) + #:export (run-timezone-page)) + +;; Heigth of the listbox displaying timezones. +(define timezone-listbox-heigth (make-parameter 20)) + +;; Information textbox width. +(define info-textbox-width (make-parameter 40)) + +(define (fill-timezones listbox timezones) + "Fill the given LISTBOX with TIMEZONES. Return an association list +correlating listbox keys with timezones." + (map (lambda (timezone) + (let ((key (append-entry-to-listbox listbox timezone))) + (cons key timezone))) + timezones)) + +(define (run-timezone-page zonetab) + "Run a page displaying available timezones, grouped by regions. The user is +invited to select a timezone. The selected timezone, under Posix format is +returned." + (define (all-but-last list) + (reverse (cdr (reverse list)))) + + (define (run-page timezone-tree) + (define (loop path) + (let ((timezones (locate-childrens timezone-tree path))) + (run-listbox-selection-page + #:title (G_ "Timezone") + #:info-text (G_ "Please select a timezone.") + #:listbox-items timezones + #:listbox-item->text identity + #:button-text (if (null? path) + (G_ "Exit") + (G_ "Back")) + #:button-callback-procedure + (if (null? path) + (lambda _ + (raise + (condition + (&installer-step-abort)))) + (lambda _ + (loop (all-but-last path)))) + #:listbox-callback-procedure + (lambda (timezone) + (let* ((timezone* (append path (list timezone))) + (tz (timezone->posix-tz timezone*))) + (if (timezone-has-child? timezone-tree timezone*) + (loop timezone*) + tz)))))) + (loop '())) + + (let ((timezone-tree (zonetab->timezone-tree zonetab))) + (run-page timezone-tree))) diff --git a/gnu/installer/newt/user.scm b/gnu/installer/newt/user.scm new file mode 100644 index 0000000000..59b1913cfc --- /dev/null +++ b/gnu/installer/newt/user.scm @@ -0,0 +1,175 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Mathieu Othacehe +;;; +;;; 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 . + +(define-module (gnu installer newt user) + #:use-module (gnu installer user) + #:use-module (gnu installer newt page) + #:use-module (gnu installer newt utils) + #:use-module (guix i18n) + #:use-module (newt) + #:use-module (ice-9 match) + #:use-module (ice-9 receive) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:export (run-user-page)) + +(define (run-user-add-page) + (define (pad-label label) + (string-pad-right label 20)) + + (let* ((label-name + (make-label -1 -1 (pad-label (G_ "Name")))) + (label-home-directory + (make-label -1 -1 (pad-label (G_ "Home directory")))) + (entry-width 30) + (entry-name (make-entry -1 -1 entry-width)) + (entry-home-directory (make-entry -1 -1 entry-width)) + (entry-grid (make-grid 2 2)) + (button-grid (make-grid 1 1)) + (ok-button (make-button -1 -1 (G_ "OK"))) + (grid (make-grid 1 2)) + (title (G_ "User creation")) + (set-entry-grid-field + (cut set-grid-field entry-grid <> <> GRID-ELEMENT-COMPONENT <>)) + (form (make-form))) + + (set-entry-grid-field 0 0 label-name) + (set-entry-grid-field 1 0 entry-name) + (set-entry-grid-field 0 1 label-home-directory) + (set-entry-grid-field 1 1 entry-home-directory) + + (set-grid-field button-grid 0 0 GRID-ELEMENT-COMPONENT ok-button) + + (add-component-callback + entry-name + (lambda (component) + (set-entry-text entry-home-directory + (string-append "/home/" (entry-value entry-name))))) + + (add-components-to-form form + label-name label-home-directory + entry-name entry-home-directory + ok-button) + + (make-wrapped-grid-window (vertically-stacked-grid + GRID-ELEMENT-SUBGRID entry-grid + GRID-ELEMENT-SUBGRID button-grid) + title) + (let ((error-page + (lambda () + (run-error-page (G_ "Empty inputs are not allowed.") + (G_ "Empty input"))))) + (receive (exit-reason argument) + (run-form form) + (dynamic-wind + (const #t) + (lambda () + (when (eq? exit-reason 'exit-component) + (cond + ((components=? argument ok-button) + (let ((name (entry-value entry-name)) + (home-directory (entry-value entry-home-directory))) + (if (or (string=? name "") + (string=? home-directory "")) + (begin + (error-page) + (run-user-add-page)) + (user + (name name) + (home-directory home-directory)))))))) + (lambda () + (destroy-form-and-pop form))))))) + +(define (run-user-page) + (define (run users) + (let* ((listbox (make-listbox + -1 -1 10 + (logior FLAG-SCROLL FLAG-BORDER))) + (info-textbox + (make-reflowed-textbox + -1 -1 + (G_ "Please add at least one user to system\ + using the 'Add' button.") + 40 #:flags FLAG-BORDER)) + (add-button (make-compact-button -1 -1 (G_ "Add"))) + (del-button (make-compact-button -1 -1 (G_ "Delete"))) + (listbox-button-grid + (apply + vertically-stacked-grid + GRID-ELEMENT-COMPONENT add-button + `(,@(if (null? users) + '() + (list GRID-ELEMENT-COMPONENT del-button))))) + (ok-button (make-button -1 -1 (G_ "OK"))) + (exit-button (make-button -1 -1 (G_ "Exit"))) + (title "User creation") + (grid + (vertically-stacked-grid + GRID-ELEMENT-COMPONENT info-textbox + GRID-ELEMENT-SUBGRID (horizontal-stacked-grid + GRID-ELEMENT-COMPONENT listbox + GRID-ELEMENT-SUBGRID listbox-button-grid) + GRID-ELEMENT-SUBGRID (horizontal-stacked-grid + GRID-ELEMENT-COMPONENT ok-button + GRID-ELEMENT-COMPONENT exit-button))) + (sorted-users (sort users (lambda (a b) + (string<= (user-name a) + (user-name b))))) + (listbox-elements + (map + (lambda (user) + `((key . ,(append-entry-to-listbox listbox + (user-name user))) + (user . ,user))) + sorted-users)) + (form (make-form))) + + + (add-form-to-grid grid form #t) + (make-wrapped-grid-window grid title) + (if (null? users) + (set-current-component form add-button) + (set-current-component form ok-button)) + + (receive (exit-reason argument) + (run-form form) + (dynamic-wind + (const #t) + (lambda () + (when (eq? exit-reason 'exit-component) + (cond + ((components=? argument add-button) + (run (cons (run-user-add-page) users))) + ((components=? argument del-button) + (let* ((current-user-key (current-listbox-entry listbox)) + (users + (map (cut assoc-ref <> 'user) + (remove (lambda (element) + (equal? (assoc-ref element 'key) + current-user-key)) + listbox-elements)))) + (run users))) + ((components=? argument ok-button) + (when (null? users) + (run-error-page (G_ "Please create at least one user.") + (G_ "No user")) + (run users)) + users)))) + (lambda () + (destroy-form-and-pop form)))))) + (run '())) diff --git a/gnu/installer/newt/utils.scm b/gnu/installer/newt/utils.scm new file mode 100644 index 0000000000..1c2ce4e628 --- /dev/null +++ b/gnu/installer/newt/utils.scm @@ -0,0 +1,43 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Mathieu Othacehe +;;; +;;; 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 . + +(define-module (gnu installer newt utils) + #:use-module (ice-9 receive) + #:use-module (newt) + #:export (screen-columns + screen-rows + + destroy-form-and-pop + set-screen-size!)) + +;; Number of columns and rows of the terminal. +(define screen-columns (make-parameter 0)) +(define screen-rows (make-parameter 0)) + +(define (destroy-form-and-pop form) + "Destory the given FORM and pop the current window." + (destroy-form form) + (pop-window)) + +(define (set-screen-size!) + "Set the parameters 'screen-columns' and 'screen-rows' to the number of +columns and rows respectively of the current terminal." + (receive (columns rows) + (screen-size) + (screen-columns columns) + (screen-rows rows))) diff --git a/gnu/installer/newt/welcome.scm b/gnu/installer/newt/welcome.scm new file mode 100644 index 0000000000..eec98e291a --- /dev/null +++ b/gnu/installer/newt/welcome.scm @@ -0,0 +1,118 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Mathieu Othacehe +;;; +;;; 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 + +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu installer newt welcome) + #:use-module (gnu installer utils) + #:use-module (gnu installer newt utils) + #:use-module (guix build syscalls) + #:use-module (guix i18n) + #:use-module (ice-9 match) + #:use-module (ice-9 receive) + #:use-module (newt) + #:export (run-welcome-page)) + +;; Expected width and height for the logo. +(define logo-width (make-parameter 43)) +(define logo-height (make-parameter 19)) + +(define info-textbox-width (make-parameter 70)) +(define options-listbox-height (make-parameter 5)) + +(define* (run-menu-page title info-text logo + #:key + listbox-items + listbox-item->text) + "Run a page with the given TITLE, to ask the user to choose between +LISTBOX-ITEMS displayed in a listbox. The listbox items are converted to text +using LISTBOX-ITEM->TEXT procedure. Display the textual LOGO in the center of +the page. Contrary to other pages, we cannot resort to grid layouts, because +we want this page to occupy all the screen space available." + (define (fill-listbox listbox items) + (map (lambda (item) + (let* ((text (listbox-item->text item)) + (key (append-entry-to-listbox listbox text))) + (cons key item))) + items)) + + (let* ((logo-textbox + (make-textbox -1 -1 (logo-width) (logo-height) 0)) + (info-textbox + (make-reflowed-textbox -1 -1 + info-text + (info-textbox-width))) + (options-listbox + (make-listbox -1 -1 + (options-listbox-height) + (logior FLAG-BORDER FLAG-RETURNEXIT))) + (keys (fill-listbox options-listbox listbox-items)) + (grid (vertically-stacked-grid + GRID-ELEMENT-COMPONENT logo-textbox + GRID-ELEMENT-COMPONENT info-textbox + GRID-ELEMENT-COMPONENT options-listbox)) + (form (make-form))) + + (set-textbox-text logo-textbox (read-all logo)) + + (add-form-to-grid grid form #t) + (make-wrapped-grid-window grid title) + + (receive (exit-reason argument) + (run-form form) + (dynamic-wind + (const #t) + (lambda () + (when (eq? exit-reason 'exit-component) + (cond + ((components=? argument options-listbox) + (let* ((entry (current-listbox-entry options-listbox)) + (item (assoc-ref keys entry))) + (match item + ((text . proc) + (proc)))))))) + (lambda () + (destroy-form-and-pop form)))))) + +(define (run-welcome-page logo) + "Run a welcome page with the given textual LOGO displayed at the center of +the page. Ask the user to choose between manual installation, graphical +installation and reboot." + (run-menu-page + (G_ "GNU GuixSD install") + (G_ "Welcome to GNU GuixSD installer! + +Please note that the present graphical installer is still under heavy \ +development, so you might want to prefer using the shell based process. \ +The documentation is accessible at any time by pressing CTRL-ALT-F2.") + logo + #:listbox-items + `((,(G_ "Graphical install using a terminal based interface") + . + ,(const #t)) + (,(G_ "Install using the shell based process") + . + ,(lambda () + ;; Switch to TTY3, where a root shell is available for shell based + ;; install. The other root TTY's would have been ok too. + (system* "chvt" "3") + (run-welcome-page logo))) + (,(G_ "Reboot") + . + ,(lambda () + (newt-finish) + (reboot)))) + #:listbox-item->text car)) diff --git a/gnu/installer/newt/wifi.scm b/gnu/installer/newt/wifi.scm new file mode 100644 index 0000000000..59e40e327e --- /dev/null +++ b/gnu/installer/newt/wifi.scm @@ -0,0 +1,243 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Mathieu Othacehe +;;; +;;; 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 . + +(define-module (gnu installer newt wifi) + #:use-module (gnu installer connman) + #:use-module (gnu installer steps) + #:use-module (gnu installer newt utils) + #:use-module (gnu installer newt page) + #:use-module (guix i18n) + #:use-module (guix records) + #:use-module (ice-9 format) + #:use-module (ice-9 popen) + #:use-module (ice-9 receive) + #:use-module (ice-9 regex) + #:use-module (ice-9 rdelim) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:use-module (newt) + #:export (run-wifi-page)) + +;; This record associates a connman service to its key the listbox. +(define-record-type* + service-item make-service-item + service-item? + (service service-item-service) ; connman + (key service-item-key)) ; newt listbox-key + +(define (strength->string strength) + "Convert STRENGTH as an integer percentage into a text printable strength +bar using unicode characters. Taken from NetworkManager's +nmc_wifi_strength_bars." + (let ((quarter #\x2582) + (half #\x2584) + (three-quarter #\x2586) + (full #\x2588)) + (cond + ((> strength 80) + ;; ▂▄▆█ + (string quarter half three-quarter full)) + ((> strength 55) + ;; ▂▄▆_ + (string quarter half three-quarter #\_)) + ((> strength 30) + ;; ▂▄__ + (string quarter half #\_ #\_)) + ((> strength 5) + ;; ▂___ + (string quarter #\_ #\_ #\_)) + (else + ;; ____ + (string quarter #\_ #\_ #\_ #\_))))) + +(define (force-wifi-scan) + "Force a wifi scan. Raise a condition if no wifi technology is available." + (let* ((technologies (connman-technologies)) + (wifi-technology + (find (lambda (technology) + (string=? (technology-type technology) "wifi")) + technologies))) + (if wifi-technology + (connman-scan-technology wifi-technology) + (raise (condition + (&message + (message (G_ "Unable to find a wifi technology")))))))) + +(define (draw-scanning-page) + "Draw a page to indicate a wifi scan in in progress." + (draw-info-page (G_ "Scanning wifi for available networks, please wait.") + (G_ "Scan in progress"))) + +(define (run-wifi-password-page) + "Run a page prompting user for a password and return it." + (run-input-page (G_ "Please enter the wifi password.") + (G_ "Password required"))) + +(define (run-wrong-password-page service-name) + "Run a page to inform user of a wrong password input." + (run-error-page + (format #f (G_ "The password you entered for ~a is incorrect.") + service-name) + (G_ "Wrong password"))) + +(define (run-unknown-error-page service-name) + "Run a page to inform user that a connection error happened." + (run-error-page + (format #f + (G_ "An error occured while trying to connect to ~a, please retry.") + service-name) + (G_ "Connection error"))) + +(define (password-callback) + (run-wifi-password-page)) + +(define (connect-wifi-service listbox service-items) + "Connect to the wifi service selected in LISTBOX. SERVICE-ITEMS is the list +of records present in LISTBOX." + (let* ((listbox-key (current-listbox-entry listbox)) + (item (find (lambda (item) + (eq? (service-item-key item) listbox-key)) + service-items)) + (service (service-item-service item)) + (service-name (service-name service)) + (form (draw-connecting-page service-name))) + (dynamic-wind + (const #t) + (lambda () + (guard (c ((connman-password-error? c) + (run-wrong-password-page service-name) + #f) + ((connman-already-connected-error? c) + #t) + ((connman-connection-error? c) + (run-unknown-error-page service-name) + #f)) + (connman-connect-with-auth service password-callback))) + (lambda () + (destroy-form-and-pop form))))) + +(define (run-wifi-scan-page) + "Force a wifi scan and draw a page during the operation." + (let ((form (draw-scanning-page))) + (force-wifi-scan) + (destroy-form-and-pop form))) + +(define (wifi-services) + "Return all the connman services of wifi type." + (let ((services (connman-services))) + (filter (lambda (service) + (and (string=? (service-type service) "wifi") + (not (string-null? (service-name service))))) + services))) + +(define* (fill-wifi-services listbox wifi-services) + "Append all the services in WIFI-SERVICES to the given LISTBOX." + (clear-listbox listbox) + (map (lambda (service) + (let* ((text (service->text service)) + (key (append-entry-to-listbox listbox text))) + (service-item + (service service) + (key key)))) + wifi-services)) + +;; Maximum length of a wifi service name. +(define service-name-max-length (make-parameter 20)) + +;; Heigth of the listbox displaying wifi services. +(define wifi-listbox-heigth (make-parameter 20)) + +;; Information textbox width. +(define info-textbox-width (make-parameter 40)) + +(define (service->text service) + "Return a string composed of the name and the strength of the given +SERVICE. A '*' preceding the service name indicates that it is connected." + (let* ((name (service-name service)) + (padded-name (string-pad-right name + (service-name-max-length))) + (strength (service-strength service)) + (strength-string (strength->string strength)) + (state (service-state service)) + (connected? (or (string=? state "online") + (string=? state "ready")))) + (format #f "~c ~a ~a~%" + (if connected? #\* #\ ) + padded-name + strength-string))) + +(define (run-wifi-page) + "Run a page displaying available wifi networks in a listbox. Connect to the +network when the corresponding listbox entry is selected. A button allow to +force a wifi scan." + (let* ((listbox (make-listbox + -1 -1 + (wifi-listbox-heigth) + (logior FLAG-SCROLL FLAG-BORDER FLAG-RETURNEXIT))) + (form (make-form)) + (buttons-grid (make-grid 1 1)) + (middle-grid (make-grid 2 1)) + (info-text (G_ "Please select a wifi network.")) + (info-textbox + (make-reflowed-textbox -1 -1 info-text + (info-textbox-width) + #:flags FLAG-BORDER)) + (exit-button (make-button -1 -1 (G_ "Exit"))) + (scan-button (make-button -1 -1 (G_ "Scan"))) + (services (wifi-services)) + (service-items '())) + + (if (null? services) + (append-entry-to-listbox listbox (G_ "No wifi detected")) + (set! service-items (fill-wifi-services listbox services))) + + (set-grid-field middle-grid 0 0 GRID-ELEMENT-COMPONENT listbox) + (set-grid-field middle-grid 1 0 GRID-ELEMENT-COMPONENT scan-button + #:anchor ANCHOR-TOP + #:pad-left 2) + (set-grid-field buttons-grid 0 0 GRID-ELEMENT-COMPONENT exit-button) + + (add-components-to-form form + info-textbox + listbox scan-button + exit-button) + (make-wrapped-grid-window + (basic-window-grid info-textbox middle-grid buttons-grid) + (G_ "Wifi")) + + (receive (exit-reason argument) + (run-form form) + (dynamic-wind + (const #t) + (lambda () + (when (eq? exit-reason 'exit-component) + (cond + ((components=? argument scan-button) + (run-wifi-scan-page) + (run-wifi-page)) + ((components=? argument exit-button) + (raise + (condition + (&installer-step-abort)))) + ((components=? argument listbox) + (let ((result (connect-wifi-service listbox service-items))) + (unless result + (run-wifi-page))))))) + (lambda () + (destroy-form-and-pop form)))))) diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm new file mode 100644 index 0000000000..187311e633 --- /dev/null +++ b/gnu/installer/parted.scm @@ -0,0 +1,1312 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018, 2019 Mathieu Othacehe +;;; +;;; 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 . + +(define-module (gnu installer parted) + #:use-module (gnu installer steps) + #:use-module (gnu installer utils) + #:use-module (gnu installer newt page) + #:use-module (gnu system uuid) + #:use-module ((gnu build file-systems) + #:select (read-partition-uuid + read-luks-partition-uuid)) + #:use-module (guix build syscalls) + #:use-module (guix build utils) + #:use-module (guix records) + #:use-module (guix utils) + #:use-module (guix i18n) + #:use-module (parted) + #:use-module (ice-9 match) + #:use-module (ice-9 regex) + #:use-module (rnrs io ports) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:export ( + user-partition + make-user-partition + user-partition? + user-partition-name + user-partition-type + user-partition-file-name + user-partition-disk-file-name + user-partition-crypt-label + user-partition-crypt-password + user-partition-fs-type + user-partition-bootable? + user-partition-esp? + user-partition-bios-grub? + user-partition-size + user-partition-start + user-partition-end + user-partition-mount-point + user-partition-need-formatting? + user-partition-parted-object + + find-esp-partition + data-partition? + metadata-partition? + freespace-partition? + small-freespace-partition? + normal-partition? + extended-partition? + logical-partition? + esp-partition? + boot-partition? + default-esp-mount-point + + with-delay-device-in-use? + force-device-sync + non-install-devices + partition-user-type + user-fs-type-name + partition-filesystem-user-type + partition-get-flags + partition->user-partition + create-special-user-partitions + find-user-partition-by-parted-object + + device-description + partition-end-formatted + partition-print-number + partition-description + partitions-descriptions + user-partition-description + + &max-primary-exceeded + max-primary-exceeded? + &extended-creation-error + extended-creation-error? + &logical-creation-error + logical-creation-error? + + can-create-partition? + mklabel + mkpart + rmpart + + create-adjacent-partitions + auto-partition + + &no-root-mount-point + no-root-mount-point? + + check-user-partitions + set-user-partitions-file-name + format-user-partitions + mount-user-partitions + umount-user-partitions + with-mounted-partitions + user-partitions->file-systems + user-partitions->configuration + + init-parted + free-parted)) + + +;;; +;;; Partition record. +;;; + +(define-record-type* + user-partition make-user-partition + user-partition? + (name user-partition-name ;string + (default #f)) + (type user-partition-type + (default 'normal)) ; 'normal | 'logical | 'extended + (file-name user-partition-file-name + (default #f)) + (disk-file-name user-partition-disk-file-name + (default #f)) + (crypt-label user-partition-crypt-label + (default #f)) + (crypt-password user-partition-crypt-password + (default #f)) + (fs-type user-partition-fs-type + (default 'ext4)) + (bootable? user-partition-bootable? + (default #f)) + (esp? user-partition-esp? + (default #f)) + (bios-grub? user-partition-bios-grub? + (default #f)) + (size user-partition-size + (default #f)) + (start user-partition-start ;start as string (e.g. '11MB') + (default #f)) + (end user-partition-end ;same as start + (default #f)) + (mount-point user-partition-mount-point ;string + (default #f)) + (need-formatting? user-partition-need-formatting? ; boolean + (default #f)) + (parted-object user-partition-parted-object ; from parted + (default #f))) + + +;; +;; Utilities. +;; + +(define (find-esp-partition partitions) + "Find and return the ESP partition among PARTITIONS." + (find esp-partition? partitions)) + +(define (data-partition? partition) + "Return #t if PARTITION is a partition dedicated to data (by opposition to +freespace, metadata and protected partition types), return #f otherwise." + (let ((type (partition-type partition))) + (not (any (lambda (flag) + (member flag type)) + '(free-space metadata protected))))) + +(define (metadata-partition? partition) + "Return #t if PARTITION is a metadata partition, #f otherwise." + (let ((type (partition-type partition))) + (member 'metadata type))) + +(define (freespace-partition? partition) + "Return #t if PARTITION is a free-space partition, #f otherwise." + (let ((type (partition-type partition))) + (member 'free-space type))) + +(define* (small-freespace-partition? device + partition + #:key (max-size MEBIBYTE-SIZE)) + "Return #t is PARTITION is a free-space partition with less a size strictly +inferior to MAX-SIZE, #f otherwise." + (let ((size (partition-length partition)) + (max-sector-size (/ max-size + (device-sector-size device)))) + (< size max-sector-size))) + +(define (normal-partition? partition) + "return #t if partition is a normal partition, #f otherwise." + (let ((type (partition-type partition))) + (member 'normal type))) + +(define (extended-partition? partition) + "return #t if partition is an extended partition, #f otherwise." + (let ((type (partition-type partition))) + (member 'extended type))) + +(define (logical-partition? partition) + "Return #t if PARTITION is a logical partition, #f otherwise." + (let ((type (partition-type partition))) + (member 'logical type))) + +(define (partition-user-type partition) + "Return the type of PARTITION, to be stored in the TYPE field of + record. It can be 'normal, 'extended or 'logical." + (cond ((normal-partition? partition) + 'normal) + ((extended-partition? partition) + 'extended) + ((logical-partition? partition) + 'logical) + (else #f))) + +(define (esp-partition? partition) + "Return #t if partition has the ESP flag, return #f otherwise." + (let* ((disk (partition-disk partition)) + (disk-type (disk-disk-type disk)) + (has-extended? (disk-type-check-feature + disk-type + DISK-TYPE-FEATURE-EXTENDED))) + (and (data-partition? partition) + (not has-extended?) + (partition-is-flag-available? partition PARTITION-FLAG-ESP) + (partition-get-flag partition PARTITION-FLAG-ESP)))) + +(define (boot-partition? partition) + "Return #t if partition has the boot flag, return #f otherwise." + (and (data-partition? partition) + (partition-is-flag-available? partition PARTITION-FLAG-BOOT) + (partition-get-flag partition PARTITION-FLAG-BOOT))) + + +;; The default mount point for ESP partitions. +(define default-esp-mount-point + (make-parameter "/boot/efi")) + +(define (efi-installation?) + "Return #t if an EFI installation should be performed, #f otherwise." + (file-exists? "/sys/firmware/efi")) + +(define (user-fs-type-name fs-type) + "Return the name of FS-TYPE as specified by libparted." + (case fs-type + ((ext4) "ext4") + ((btrfs) "btrfs") + ((fat32) "fat32") + ((swap) "linux-swap"))) + +(define (user-fs-type->mount-type fs-type) + "Return the mount type of FS-TYPE." + (case fs-type + ((ext4) "ext4") + ((btrfs) "btrfs") + ((fat32) "vfat"))) + +(define (partition-filesystem-user-type partition) + "Return the filesystem type of PARTITION, to be stored in the FS-TYPE field +of record." + (let ((fs-type (partition-fs-type partition))) + (and fs-type + (let ((name (filesystem-type-name fs-type))) + (cond + ((string=? name "ext4") 'ext4) + ((string=? name "btrfs") 'btrfs) + ((string=? name "fat32") 'fat32) + ((or (string=? name "swsusp") + (string=? name "linux-swap(v0)") + (string=? name "linux-swap(v1)")) + 'swap) + (else + (error (format #f "Unhandled ~a fs-type~%" name)))))))) + +(define (partition-get-flags partition) + "Return the list of flags supported by the given PARTITION." + (filter-map (lambda (flag) + (and (partition-get-flag partition flag) + flag)) + (partition-flags partition))) + +(define (partition->user-partition partition) + "Convert PARTITION into a record and return it." + (let* ((disk (partition-disk partition)) + (device (disk-device disk)) + (disk-type (disk-disk-type disk)) + (has-name? (disk-type-check-feature + disk-type + DISK-TYPE-FEATURE-PARTITION-NAME)) + (name (and has-name? + (data-partition? partition) + (partition-get-name partition)))) + (user-partition + (name (and (and name + (not (string=? name ""))) + name)) + (type (or (partition-user-type partition) + 'normal)) + (file-name (partition-get-path partition)) + (disk-file-name (device-path device)) + (fs-type (or (partition-filesystem-user-type partition) + 'ext4)) + (mount-point (and (esp-partition? partition) + (default-esp-mount-point))) + (bootable? (boot-partition? partition)) + (esp? (esp-partition? partition)) + (parted-object partition)))) + +(define (create-special-user-partitions partitions) + "Return a list with a record describing the ESP partition +found in PARTITIONS, if any." + (filter-map (lambda (partition) + (and (esp-partition? partition) + (partition->user-partition partition))) + partitions)) + +(define (find-user-partition-by-parted-object user-partitions + partition) + "Find and return the record in USER-PARTITIONS list which +PARTED-OBJECT field equals PARTITION, return #f if not found." + (find (lambda (user-partition) + (equal? (user-partition-parted-object user-partition) + partition)) + user-partitions)) + + +;; +;; Devices +;; + +(define (with-delay-device-in-use? file-name) + "Call DEVICE-IN-USE? with a few retries, as the first re-read will often +fail. See rereadpt function in wipefs.c of util-linux for an explanation." + ;; Kernel always return EINVAL for BLKRRPART on loopdevices. + (and (not (string-match "/dev/loop*" file-name)) + (let loop ((try 4)) + (usleep 250000) + (let ((in-use? (device-in-use? file-name))) + (if (and in-use? (> try 0)) + (loop (- try 1)) + in-use?))))) + +(define* (force-device-sync device) + "Force a flushing of the given DEVICE." + (device-open device) + (device-sync device) + (device-close device)) + +(define (non-install-devices) + "Return all the available devices, except the busy one, allegedly the +install device. DEVICE-IS-BUSY? is a parted call, checking if the device is +mounted. The install image uses an overlayfs so the install device does not +appear as mounted and won't be considered as busy. So use also DEVICE-IN-USE? +from (guix build syscalls) module, who will try to re-read the device's +partition table to determine whether or not it is already used (like sfdisk +from util-linux)." + (remove (lambda (device) + (let ((file-name (device-path device))) + (or (device-is-busy? device) + (with-delay-device-in-use? file-name)))) + (devices))) + + +;; +;; Disk and partition printing. +;; + +(define* (device-description device #:optional disk) + "Return a string describing the given DEVICE." + (let* ((type (device-type device)) + (file-name (device-path device)) + (model (device-model device)) + (type-str (device-type->string type)) + (disk-type (if disk + (disk-disk-type disk) + (disk-probe device))) + (length (device-length device)) + (sector-size (device-sector-size device)) + (end (unit-format-custom-byte device + (* length sector-size) + UNIT-GIGABYTE))) + (string-join + `(,@(if (string=? model "") + `(,type-str) + `(,model ,(string-append "(" type-str ")"))) + ,file-name + ,end + ,@(if disk-type + `(,(disk-type-name disk-type)) + '())) + " "))) + +(define (partition-end-formatted device partition) + "Return as a string the end of PARTITION with the relevant unit." + (unit-format-byte + device + (- + (* (+ (partition-end partition) 1) + (device-sector-size device)) + 1))) + +(define (partition-print-number partition) + "Convert the given partition NUMBER to string." + (let ((number (partition-number partition))) + (number->string number))) + +(define (partition-description partition user-partition) + "Return a string describing the given PARTITION, located on the DISK of +DEVICE." + + (define (partition-print-type partition) + "Return the type of PARTITION as a string." + (if (freespace-partition? partition) + (G_ "Free space") + (let ((type (partition-type partition))) + (match type + ((type-symbol) + (symbol->string type-symbol)))))) + + (define (partition-print-flags partition) + "Return the flags of PARTITION as a string of comma separated flags." + (string-join + (filter-map + (lambda (flag) + (and (partition-get-flag partition flag) + (partition-flag-get-name flag))) + (partition-flags partition)) + ",")) + + (define (maybe-string-pad string length) + "Returned a string formatted by padding STRING of LENGTH characters to the +right. If STRING is #f use an empty string." + (if (and string (not (string=? string ""))) + (string-pad-right string length) + "")) + + (let* ((disk (partition-disk partition)) + (device (disk-device disk)) + (disk-type (disk-disk-type disk)) + (has-name? (disk-type-check-feature + disk-type + DISK-TYPE-FEATURE-PARTITION-NAME)) + (has-extended? (disk-type-check-feature + disk-type + DISK-TYPE-FEATURE-EXTENDED)) + (part-type (partition-print-type partition)) + (number (and (not (freespace-partition? partition)) + (partition-print-number partition))) + (name (and has-name? + (if (freespace-partition? partition) + (G_ "Free space") + (partition-get-name partition)))) + (start (unit-format device + (partition-start partition))) + (end (partition-end-formatted device partition)) + (size (unit-format device (partition-length partition))) + (fs-type (partition-fs-type partition)) + (fs-type-name (and fs-type + (filesystem-type-name fs-type))) + (crypt-label (and user-partition + (user-partition-crypt-label user-partition))) + (flags (and (not (freespace-partition? partition)) + (partition-print-flags partition))) + (mount-point (and user-partition + (user-partition-mount-point user-partition)))) + `(,(or number "") + ,@(if has-extended? + (list part-type) + '()) + ,size + ,(or fs-type-name "") + ,(or flags "") + ,(or mount-point "") + ,(or crypt-label "") + ,(maybe-string-pad name 30)))) + +(define (partitions-descriptions partitions user-partitions) + "Return a list of strings describing all the partitions found on +DEVICE. METADATA partitions are not described. The strings are padded to the +right so that they can be displayed as a table." + + (define (max-length-column lists column-index) + "Return the maximum length of the string at position COLUMN-INDEX in the +list of string lists LISTS." + (apply max + (map (lambda (list) + (string-length + (list-ref list column-index))) + lists))) + + (define (pad-descriptions descriptions) + "Return a padded version of the list of string lists DESCRIPTIONS. The +strings are padded to the length of the longer string in a same column, as +determined by MAX-LENGTH-COLUMN procedure." + (let* ((description-length (length (car descriptions))) + (paddings (map (lambda (index) + (max-length-column descriptions index)) + (iota description-length)))) + (map (lambda (description) + (map string-pad-right description paddings)) + descriptions))) + + (let* ((descriptions + (map + (lambda (partition) + (let ((user-partition + (find-user-partition-by-parted-object user-partitions + partition))) + (partition-description partition user-partition))) + partitions)) + (padded-descriptions (if (null? partitions) + '() + (pad-descriptions descriptions)))) + (map (cut string-join <> " ") padded-descriptions))) + +(define (user-partition-description user-partition) + "Return a string describing the given USER-PARTITION record." + (let* ((partition (user-partition-parted-object user-partition)) + (disk (partition-disk partition)) + (disk-type (disk-disk-type disk)) + (device (disk-device disk)) + (has-name? (disk-type-check-feature + disk-type + DISK-TYPE-FEATURE-PARTITION-NAME)) + (has-extended? (disk-type-check-feature + disk-type + DISK-TYPE-FEATURE-EXTENDED)) + (name (user-partition-name user-partition)) + (type (user-partition-type user-partition)) + (type-name (symbol->string type)) + (fs-type (user-partition-fs-type user-partition)) + (fs-type-name (user-fs-type-name fs-type)) + (bootable? (user-partition-bootable? user-partition)) + (esp? (user-partition-esp? user-partition)) + (need-formatting? (user-partition-need-formatting? user-partition)) + (crypt-label (user-partition-crypt-label user-partition)) + (size (user-partition-size user-partition)) + (mount-point (user-partition-mount-point user-partition))) + `(,@(if has-name? + `((name . ,(string-append "Name: " (or name "None")))) + '()) + ,@(if (and has-extended? + (freespace-partition? partition) + (not (eq? type 'logical))) + `((type . ,(string-append "Type: " type-name))) + '()) + ,@(if (eq? type 'extended) + '() + `((fs-type . ,(string-append "Filesystem type: " fs-type-name)))) + ,@(if (or (eq? type 'extended) + (eq? fs-type 'swap) + (not has-extended?)) + '() + `((bootable . ,(string-append "Bootable flag: " + (if bootable? "On" "Off"))))) + ,@(if (and (not has-extended?) + (not (eq? fs-type 'swap))) + `((esp? . ,(string-append "ESP flag: " + (if esp? "On" "Off")))) + '()) + ,@(if (freespace-partition? partition) + (let ((size-formatted + (or size (unit-format device + (partition-length partition))))) + `((size . ,(string-append "Size : " size-formatted)))) + '()) + ,@(if (or (eq? type 'extended) + (eq? fs-type 'swap)) + '() + `((crypt-label + . ,(string-append + "Encryption: " + (if crypt-label + (format #f "Yes (label ~a)" crypt-label) + "No"))))) + ,@(if (or (freespace-partition? partition) + (eq? fs-type 'swap)) + '() + `((need-formatting? + . ,(string-append "Format the partition? : " + (if need-formatting? "Yes" "No"))))) + ,@(if (or (eq? type 'extended) + (eq? fs-type 'swap)) + '() + `((mount-point + . ,(string-append "Mount point : " + (or mount-point + (and esp? (default-esp-mount-point)) + "None")))))))) + + +;; +;; Partition table creation. +;; + +(define (mklabel device type-name) + "Create a partition table on DEVICE. TYPE-NAME is the type of the partition +table, \"msdos\" or \"gpt\"." + (let ((type (disk-type-get type-name))) + (disk-new-fresh device type))) + + +;; +;; Partition creation. +;; + +;; The maximum count of primary partitions is exceeded. +(define-condition-type &max-primary-exceeded &condition + max-primary-exceeded?) + +;; It is not possible to create an extended partition. +(define-condition-type &extended-creation-error &condition + extended-creation-error?) + +;; It is not possible to create a logical partition. +(define-condition-type &logical-creation-error &condition + logical-creation-error?) + +(define (can-create-primary? disk) + "Return #t if it is possible to create a primary partition on DISK, return +#f otherwise." + (let ((max-primary (disk-get-max-primary-partition-count disk))) + (find (lambda (number) + (not (disk-get-partition disk number))) + (iota max-primary 1)))) + +(define (can-create-extended? disk) + "Return #t if it is possible to create an extended partition on DISK, return +#f otherwise." + (let* ((disk-type (disk-disk-type disk)) + (has-extended? (disk-type-check-feature + disk-type + DISK-TYPE-FEATURE-EXTENDED))) + (and (can-create-primary? disk) + has-extended? + (not (disk-extended-partition disk))))) + +(define (can-create-logical? disk) + "Return #t is it is possible to create a logical partition on DISK, return +#f otherwise." + (let* ((disk-type (disk-disk-type disk)) + (has-extended? (disk-type-check-feature + disk-type + DISK-TYPE-FEATURE-EXTENDED))) + (and has-extended? + (disk-extended-partition disk)))) + +(define (can-create-partition? user-part) + "Return #t if it is possible to create the given USER-PART record, return #f +otherwise." + (let* ((type (user-partition-type user-part)) + (partition (user-partition-parted-object user-part)) + (disk (partition-disk partition))) + (case type + ((normal) + (or (can-create-primary? disk) + (raise + (condition (&max-primary-exceeded))))) + ((extended) + (or (can-create-extended? disk) + (raise + (condition (&extended-creation-error))))) + ((logical) + (or (can-create-logical? disk) + (raise + (condition (&logical-creation-error)))))))) + +(define* (mkpart disk user-partition + #:key (previous-partition #f)) + "Create the given USER-PARTITION on DISK. The PREVIOUS-PARTITION argument as +to be set to the partition preceeding USER-PARTITION if any." + + (define (parse-start-end start end) + "Parse start and end strings as positions on DEVICE expressed with a unit, +like '100GB' or '12.2KiB'. Return a list of 4 elements, the start sector, its +range (1 unit large area centered on start sector), the end sector and its +range." + (let ((device (disk-device disk))) + (call-with-values + (lambda () + (unit-parse start device)) + (lambda (start-sector start-range) + (call-with-values + (lambda () + (unit-parse end device)) + (lambda (end-sector end-range) + (list start-sector start-range + end-sector end-range))))))) + + (define* (extend-ranges! start-range end-range + #:key (offset 0)) + "Try to extend START-RANGE by 1 MEBIBYTE to the right and END-RANGE by 1 +MEBIBYTE to the left. This way, if the disk is aligned on 2048 sectors of +512KB (like frequently), we will have a chance for the +'optimal-align-constraint' to succeed. Do not extend ranges if that would +cause them to cross." + (let* ((device (disk-device disk)) + (start-range-end (geometry-end start-range)) + (end-range-start (geometry-start end-range)) + (mebibyte-sector-size (/ MEBIBYTE-SIZE + (device-sector-size device))) + (new-start-range-end + (+ start-range-end mebibyte-sector-size offset)) + (new-end-range-start + (- end-range-start mebibyte-sector-size offset))) + (when (< new-start-range-end new-end-range-start) + (geometry-set-end start-range new-start-range-end) + (geometry-set-start end-range new-end-range-start)))) + + (match (parse-start-end (user-partition-start user-partition) + (user-partition-end user-partition)) + ((start-sector start-range end-sector end-range) + (let* ((prev-end (if previous-partition + (partition-end previous-partition) + 0)) + (start-distance (- start-sector prev-end)) + (type (user-partition-type user-partition)) + ;; There should be at least 2 unallocated sectors in front of each + ;; logical partition, otherwise parted will fail badly: + ;; https://gparted.org/h2-fix-msdos-pt.php#apply-action-fail. + (start-offset (if previous-partition + (- 3 start-distance) + 0)) + (start-sector* (if (and (eq? type 'logical) + (< start-distance 3)) + (+ start-sector start-offset) + start-sector))) + ;; This is a hackery but parted almost always fails to create optimally + ;; aligned partitions (unless specifiying percentages) because, the + ;; default range of 1MB centered on the start sector is not enough when + ;; the optimal alignment is 2048 sectors of 512KB. + (extend-ranges! start-range end-range #:offset start-offset) + + (let* ((device (disk-device disk)) + (disk-type (disk-disk-type disk)) + (length (device-length device)) + (name (user-partition-name user-partition)) + (filesystem-type + (filesystem-type-get + (user-fs-type-name + (user-partition-fs-type user-partition)))) + (flags `(,@(if (user-partition-bootable? user-partition) + `(,PARTITION-FLAG-BOOT) + '()) + ,@(if (user-partition-esp? user-partition) + `(,PARTITION-FLAG-ESP) + '()) + ,@(if (user-partition-bios-grub? user-partition) + `(,PARTITION-FLAG-BIOS-GRUB) + '()))) + (has-name? (disk-type-check-feature + disk-type + DISK-TYPE-FEATURE-PARTITION-NAME)) + (partition-type (partition-type->int type)) + (partition (partition-new disk + #:type partition-type + #:filesystem-type filesystem-type + #:start start-sector* + #:end end-sector)) + (user-constraint (constraint-new + #:start-align 'any + #:end-align 'any + #:start-range start-range + #:end-range end-range + #:min-size 1 + #:max-size length)) + (dev-constraint + (device-get-optimal-aligned-constraint device)) + (final-constraint (constraint-intersect user-constraint + dev-constraint)) + (no-constraint (constraint-any device)) + ;; Try to create a partition with an optimal alignment + ;; constraint. If it fails, fallback to creating a partition with + ;; no specific constraint. + (partition-ok? + (or (disk-add-partition disk partition final-constraint) + (disk-add-partition disk partition no-constraint)))) + ;; Set the partition name if supported. + (when (and partition-ok? has-name? name) + (partition-set-name partition name)) + + ;; Set flags is required. + (for-each (lambda (flag) + (and (partition-is-flag-available? partition flag) + (partition-set-flag partition flag 1))) + flags) + + (and partition-ok? + (partition-set-system partition filesystem-type) + partition)))))) + + +;; +;; Partition destruction. +;; + +(define (rmpart disk number) + "Remove the partition with the given NUMBER on DISK." + (let ((partition (disk-get-partition disk number))) + (disk-remove-partition disk partition))) + + +;; +;; Auto partitionning. +;; + +(define* (create-adjacent-partitions disk partitions + #:key (last-partition-end 0)) + "Create the given PARTITIONS on DISK. LAST-PARTITION-END is the sector from +which we want to start creating partitions. The START and END of each created +partition are computed from its SIZE value and the position of the last +partition." + (let ((device (disk-device disk))) + (let loop ((partitions partitions) + (remaining-space (- (device-length device) + last-partition-end)) + (start last-partition-end)) + (match partitions + (() '()) + ((partition . rest) + (let* ((size (user-partition-size partition)) + (percentage-size (and (string? size) + (read-percentage size))) + (sector-size (device-sector-size device)) + (partition-size (if percentage-size + (exact->inexact + (* (/ percentage-size 100) + remaining-space)) + size)) + (end-partition (min (- (device-length device) 1) + (nearest-exact-integer + (+ start partition-size 1)))) + (name (user-partition-name partition)) + (type (user-partition-type partition)) + (fs-type (user-partition-fs-type partition)) + (start-formatted (unit-format-custom device + start + UNIT-SECTOR)) + (end-formatted (unit-format-custom device + end-partition + UNIT-SECTOR)) + (new-user-partition (user-partition + (inherit partition) + (start start-formatted) + (end end-formatted))) + (new-partition + (mkpart disk new-user-partition))) + (if new-partition + (cons (user-partition + (inherit new-user-partition) + (file-name (partition-get-path new-partition)) + (disk-file-name (device-path device)) + (parted-object new-partition)) + (loop rest + (if (eq? type 'extended) + remaining-space + (- remaining-space + (partition-length new-partition))) + (if (eq? type 'extended) + (+ start 1) + (+ (partition-end new-partition) 1)))) + (error + (format #f "Unable to create partition ~a~%" name))))))))) + +(define (force-user-partitions-formatting user-partitions) + "Set the NEED-FORMATING? fields to #t on all records of +USER-PARTITIONS list and return the updated list." + (map (lambda (p) + (user-partition + (inherit p) + (need-formatting? #t))) + user-partitions)) + +(define* (auto-partition disk + #:key + (scheme 'entire-root)) + "Automatically create partitions on DISK. All the previous +partitions (except the ESP on a GPT disk, if present) are wiped. SCHEME is the +desired partitioning scheme. It can be 'entire-root or +'entire-root-home. 'entire-root will create a swap partition and a root +partition occupying all the remaining space. 'entire-root-home will create a +swap partition, a root partition and a home partition." + (let* ((device (disk-device disk)) + (disk-type (disk-disk-type disk)) + (has-extended? (disk-type-check-feature + disk-type + DISK-TYPE-FEATURE-EXTENDED)) + (partitions (filter data-partition? (disk-partitions disk))) + (esp-partition (find-esp-partition partitions)) + ;; According to + ;; https://wiki.archlinux.org/index.php/EFI_system_partition, the ESP + ;; size should be at least 550MiB. + (new-esp-size (nearest-exact-integer + (/ (* 550 MEBIBYTE-SIZE) + (device-sector-size device)))) + (end-esp-partition (and esp-partition + (partition-end esp-partition))) + (non-boot-partitions (remove esp-partition? partitions)) + (bios-grub-size (/ (* 3 MEBIBYTE-SIZE) + (device-sector-size device))) + (five-percent-disk (nearest-exact-integer + (* 0.05 (device-length device)))) + (default-swap-size (nearest-exact-integer + (/ (* 4 GIGABYTE-SIZE) + (device-sector-size device)))) + ;; Use a 4GB size for the swap if it represents less than 5% of the + ;; disk space. Otherwise, set the swap size to 5% of the disk space. + (swap-size (min default-swap-size five-percent-disk))) + + (if has-extended? + ;; msdos - remove everything. + (disk-delete-all disk) + ;; gpt - remove everything but esp if it exists. + (for-each + (lambda (partition) + (and (data-partition? partition) + (disk-remove-partition disk partition))) + non-boot-partitions)) + + (let* ((start-partition + (and (not has-extended?) + (not esp-partition) + (if (efi-installation?) + (user-partition + (fs-type 'fat32) + (esp? #t) + (size new-esp-size) + (mount-point (default-esp-mount-point))) + (user-partition + (fs-type 'ext4) + (bootable? #t) + (bios-grub? #t) + (size bios-grub-size))))) + (new-partitions + (cond + ((or (eq? scheme 'entire-root) + (eq? scheme 'entire-encrypted-root)) + (let ((encrypted? (eq? scheme 'entire-encrypted-root))) + `(,@(if start-partition + `(,start-partition) + '()) + ,@(if encrypted? + '() + `(,(user-partition + (fs-type 'swap) + (size swap-size)))) + ,(user-partition + (fs-type 'ext4) + (bootable? has-extended?) + (crypt-label (and encrypted? "cryptroot")) + (size "100%") + (mount-point "/"))))) + ((or (eq? scheme 'entire-root-home) + (eq? scheme 'entire-encrypted-root-home)) + (let ((encrypted? (eq? scheme 'entire-encrypted-root-home))) + `(,@(if start-partition + `(,start-partition) + '()) + ,(user-partition + (fs-type 'ext4) + (bootable? has-extended?) + (crypt-label (and encrypted? "cryptroot")) + (size "33%") + (mount-point "/")) + ,@(if has-extended? + `(,(user-partition + (type 'extended) + (size "100%"))) + '()) + ,@(if encrypted? + '() + `(,(user-partition + (type (if has-extended? + 'logical + 'normal)) + (fs-type 'swap) + (size swap-size)))) + ,(user-partition + (type (if has-extended? + 'logical + 'normal)) + (fs-type 'ext4) + (crypt-label (and encrypted? "crypthome")) + (size "100%") + (mount-point "/home"))))))) + (new-partitions* (force-user-partitions-formatting + new-partitions))) + (create-adjacent-partitions disk + new-partitions* + #:last-partition-end + (or end-esp-partition 0))))) + + +;; +;; Convert user-partitions. +;; + +;; No root mount point found. +(define-condition-type &no-root-mount-point &condition + no-root-mount-point?) + +(define (check-user-partitions user-partitions) + "Return #t if the USER-PARTITIONS lists contains one record +with a mount-point set to '/', raise &no-root-mount-point condition +otherwise." + (let ((mount-points + (map user-partition-mount-point user-partitions))) + (or (member "/" mount-points) + (raise + (condition (&no-root-mount-point)))))) + +(define (set-user-partitions-file-name user-partitions) + "Set the partition file-name of records in USER-PARTITIONS +list and return the updated list." + (map (lambda (p) + (let* ((partition (user-partition-parted-object p)) + (file-name (partition-get-path partition))) + (user-partition + (inherit p) + (file-name file-name)))) + user-partitions)) + +(define-syntax-rule (with-null-output-ports exp ...) + "Evaluate EXP with both the output port and the error port pointing to the +bit bucket." + (with-output-to-port (%make-void-port "w") + (lambda () + (with-error-to-port (%make-void-port "w") + (lambda () exp ...))))) + +(define (create-ext4-file-system partition) + "Create an ext4 file-system for PARTITION file-name." + (with-null-output-ports + (invoke "mkfs.ext4" "-F" partition))) + +(define (create-fat32-file-system partition) + "Create an ext4 file-system for PARTITION file-name." + (with-null-output-ports + (invoke "mkfs.fat" "-F32" partition))) + +(define (create-swap-partition partition) + "Set up swap area on PARTITION file-name." + (with-null-output-ports + (invoke "mkswap" "-f" partition))) + +(define (call-with-luks-key-file password proc) + "Write PASSWORD in a temporary file and pass it to PROC as argument." + (call-with-temporary-output-file + (lambda (file port) + (put-string port password) + (close port) + (proc file)))) + +(define (user-partition-upper-file-name user-partition) + "Return the file-name of the virtual block device corresponding to +USER-PARTITION if it is encrypted, or the plain file-name otherwise." + (let ((crypt-label (user-partition-crypt-label user-partition)) + (file-name (user-partition-file-name user-partition))) + (if crypt-label + (string-append "/dev/mapper/" crypt-label) + file-name))) + +(define (luks-format-and-open user-partition) + "Format and open the encrypted partition pointed by USER-PARTITION." + (let* ((file-name (user-partition-file-name user-partition)) + (label (user-partition-crypt-label user-partition)) + (password (user-partition-crypt-password user-partition))) + (call-with-luks-key-file + password + (lambda (key-file) + (system* "cryptsetup" "-q" "luksFormat" file-name key-file) + (system* "cryptsetup" "open" "--type" "luks" + "--key-file" key-file file-name label))))) + +(define (luks-close user-partition) + "Close the encrypted partition pointed by USER-PARTITION." + (let ((label (user-partition-crypt-label user-partition))) + (system* "cryptsetup" "close" label))) + +(define (format-user-partitions user-partitions) + "Format the records in USER-PARTITIONS list with +NEED-FORMATING? field set to #t." + (for-each + (lambda (user-partition) + (let* ((need-formatting? + (user-partition-need-formatting? user-partition)) + (type (user-partition-type user-partition)) + (crypt-label (user-partition-crypt-label user-partition)) + (file-name (user-partition-upper-file-name user-partition)) + (fs-type (user-partition-fs-type user-partition))) + (when crypt-label + (luks-format-and-open user-partition)) + + (case fs-type + ((ext4) + (and need-formatting? + (not (eq? type 'extended)) + (create-ext4-file-system file-name))) + ((fat32) + (and need-formatting? + (not (eq? type 'extended)) + (create-fat32-file-system file-name))) + ((swap) + (create-swap-partition file-name)) + (else + ;; TODO: Add support for other file-system types. + #t)))) + user-partitions)) + +(define (sort-partitions user-partitions) + "Sort USER-PARTITIONS by mount-points, so that the more nested mount-point +comes last. This is useful to mount/umount partitions in a coherent order." + (sort user-partitions + (lambda (a b) + (let ((mount-point-a (user-partition-mount-point a)) + (mount-point-b (user-partition-mount-point b))) + (string-prefix? mount-point-a mount-point-b))))) + +(define (mount-user-partitions user-partitions) + "Mount the records in USER-PARTITIONS list on their +respective mount-points." + (let* ((mount-partitions (filter user-partition-mount-point user-partitions)) + (sorted-partitions (sort-partitions mount-partitions))) + (for-each (lambda (user-partition) + (let* ((mount-point + (user-partition-mount-point user-partition)) + (target + (string-append (%installer-target-dir) + mount-point)) + (fs-type + (user-partition-fs-type user-partition)) + (crypt-label + (user-partition-crypt-label user-partition)) + (mount-type + (user-fs-type->mount-type fs-type)) + (file-name + (user-partition-upper-file-name user-partition))) + (mkdir-p target) + (mount file-name target mount-type))) + sorted-partitions))) + +(define (umount-user-partitions user-partitions) + "Unmount all the records in USER-PARTITIONS list." + (let* ((mount-partitions (filter user-partition-mount-point user-partitions)) + (sorted-partitions (sort-partitions mount-partitions))) + (for-each (lambda (user-partition) + (let* ((mount-point + (user-partition-mount-point user-partition)) + (crypt-label + (user-partition-crypt-label user-partition)) + (target + (string-append (%installer-target-dir) + mount-point))) + (umount target) + (when crypt-label + (luks-close user-partition)))) + (reverse sorted-partitions)))) + +(define (find-swap-user-partitions user-partitions) + "Return the subset of records in USER-PARTITIONS list with +the FS-TYPE field set to 'swap, return the empty list if none found." + (filter (lambda (user-partition) + (let ((fs-type (user-partition-fs-type user-partition))) + (eq? fs-type 'swap))) + user-partitions)) + +(define (start-swapping user-partitions) + "Start swaping on records with FS-TYPE equal to 'swap." + (let* ((swap-user-partitions (find-swap-user-partitions user-partitions)) + (swap-devices (map user-partition-file-name swap-user-partitions))) + (for-each swapon swap-devices))) + +(define (stop-swapping user-partitions) + "Stop swaping on records with FS-TYPE equal to 'swap." + (let* ((swap-user-partitions (find-swap-user-partitions user-partitions)) + (swap-devices (map user-partition-file-name swap-user-partitions))) + (for-each swapoff swap-devices))) + +(define-syntax-rule (with-mounted-partitions user-partitions exp ...) + "Mount USER-PARTITIONS and start swapping within the dynamic extent of EXP." + (dynamic-wind + (lambda () + (mount-user-partitions user-partitions) + (start-swapping user-partitions)) + (lambda () + exp ...) + (lambda () + (umount-user-partitions user-partitions) + (stop-swapping user-partitions) + #f))) + +(define (user-partition->file-system user-partition) + "Convert the given USER-PARTITION record in a FILE-SYSTEM record from +(gnu system file-systems) module and return it." + (let* ((mount-point (user-partition-mount-point user-partition)) + (fs-type (user-partition-fs-type user-partition)) + (crypt-label (user-partition-crypt-label user-partition)) + (mount-type (user-fs-type->mount-type fs-type)) + (file-name (user-partition-file-name user-partition)) + (upper-file-name (user-partition-upper-file-name user-partition)) + ;; Only compute uuid if partition is not encrypted. + (uuid (or crypt-label + (uuid->string (read-partition-uuid file-name) fs-type)))) + `(file-system + (mount-point ,mount-point) + (device ,@(if crypt-label + `(,upper-file-name) + `((uuid ,uuid (quote ,fs-type))))) + (type ,mount-type) + ,@(if crypt-label + '((dependencies mapped-devices)) + '())))) + +(define (user-partitions->file-systems user-partitions) + "Convert the given USER-PARTITIONS list of records into a +list of records." + (filter-map + (lambda (user-partition) + (let ((mount-point + (user-partition-mount-point user-partition))) + (and mount-point + (user-partition->file-system user-partition)))) + user-partitions)) + +(define (user-partition->mapped-device user-partition) + "Convert the given USER-PARTITION record into a MAPPED-DEVICE record +from (gnu system mapped-devices) and return it." + (let ((label (user-partition-crypt-label user-partition)) + (file-name (user-partition-file-name user-partition))) + `(mapped-device + (source (uuid ,(uuid->string + (read-luks-partition-uuid file-name) + 'luks))) + (target ,label) + (type luks-device-mapping)))) + +(define (bootloader-configuration user-partitions) + "Return the bootloader configuration field for USER-PARTITIONS." + (let* ((root-partition + (find (lambda (user-partition) + (let ((mount-point + (user-partition-mount-point user-partition))) + (and mount-point + (string=? mount-point "/")))) + user-partitions)) + (root-partition-disk (user-partition-disk-file-name root-partition))) + `((bootloader-configuration + ,@(if (efi-installation?) + `((bootloader grub-efi-bootloader) + (target ,(default-esp-mount-point))) + `((bootloader grub-bootloader) + (target ,root-partition-disk))))))) + +(define (user-partitions->configuration user-partitions) + "Return the configuration field for USER-PARTITIONS." + (let* ((swap-user-partitions (find-swap-user-partitions user-partitions)) + (swap-devices (map user-partition-file-name swap-user-partitions)) + (encrypted-partitions + (filter user-partition-crypt-label user-partitions))) + `(,@(if (null? swap-devices) + '() + `((swap-devices (list ,@swap-devices)))) + (bootloader ,@(bootloader-configuration user-partitions)) + ,@(if (null? encrypted-partitions) + '() + `((mapped-devices + (list ,@(map user-partition->mapped-device + encrypted-partitions))))) + (file-systems (cons* + ,@(user-partitions->file-systems user-partitions) + %base-file-systems))))) + + +;; +;; Initialization. +;; + +(define (init-parted) + "Initialize libparted support." + (probe-all-devices) + (exception-set-handler (lambda (exception) + EXCEPTION-OPTION-UNHANDLED))) + +(define (free-parted devices) + "Deallocate memory used for DEVICES in parted, force sync them and wait for +the devices not to be used before returning." + ;; XXX: Formatting and further operations on disk partition table may fail + ;; because the partition table changes are not synced, or because the device + ;; is still in use, even if parted should have finished editing + ;; partitions. This is not well understood, but syncing devices and waiting + ;; them to stop returning EBUSY to BLKRRPART ioctl seems to be enough. The + ;; same kind of issue is described here: + ;; https://mail.gnome.org/archives/commits-list/2013-March/msg18423.html. + (let ((device-file-names (map device-path devices))) + (for-each force-device-sync devices) + (free-all-devices) + (for-each (lambda (file-name) + (let ((in-use? (with-delay-device-in-use? file-name))) + (and in-use? + (error + (format #f (G_ "Device ~a is still in use.") + file-name))))) + device-file-names))) diff --git a/gnu/installer/record.scm b/gnu/installer/record.scm new file mode 100644 index 0000000000..edf73b6215 --- /dev/null +++ b/gnu/installer/record.scm @@ -0,0 +1,84 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Mathieu Othacehe +;;; +;;; 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 . + +(define-module (gnu installer record) + #:use-module (guix records) + #:use-module (srfi srfi-1) + #:export ( + installer + make-installer + installer? + installer-name + installer-init + installer-exit + installer-exit-error + installer-final-page + installer-keymap-page + installer-locale-page + installer-menu-page + installer-network-page + installer-timezone-page + installer-hostname-page + installer-user-page + installer-partition-page + installer-services-page + installer-welcome-page)) + + +;;; +;;; Installer record. +;;; + +;; The record contains pages that will be run to prompt the user +;; for the system configuration. The goal of the installer is to produce a +;; complete record and install it. + +(define-record-type* + installer make-installer + installer? + ;; symbol + (name installer-name) + ;; procedure: void -> void + (init installer-init) + ;; procedure: void -> void + (exit installer-exit) + ;; procedure (key arguments) -> void + (exit-error installer-exit-error) + ;; procedure void -> void + (final-page installer-final-page) + ;; procedure (layouts) -> (list layout variant) + (keymap-page installer-keymap-page) + ;; procedure: (#:key supported-locales iso639-languages iso3166-territories) + ;; -> glibc-locale + (locale-page installer-locale-page) + ;; procedure: (steps) -> step-id + (menu-page installer-menu-page) + ;; procedure void -> void + (network-page installer-network-page) + ;; procedure (zonetab) -> posix-timezone + (timezone-page installer-timezone-page) + ;; procedure void -> void + (hostname-page installer-hostname-page) + ;; procedure void -> void + (user-page installer-user-page) + ;; procedure void -> void + (partition-page installer-partition-page) + ;; procedure void -> void + (services-page installer-services-page) + ;; procedure (logo) -> void + (welcome-page installer-welcome-page)) diff --git a/gnu/installer/services.scm b/gnu/installer/services.scm new file mode 100644 index 0000000000..ed44b87682 --- /dev/null +++ b/gnu/installer/services.scm @@ -0,0 +1,59 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Mathieu Othacehe +;;; +;;; 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 . + +(define-module (gnu installer services) + #:use-module (guix records) + #:export ( + desktop-environment + make-desktop-environment + desktop-environment-name + desktop-environment-snippet + + %desktop-environments + desktop-environments->configuration)) + +(define-record-type* + desktop-environment make-desktop-environment + desktop-environment? + (name desktop-environment-name) ;string + (snippet desktop-environment-snippet)) ;symbol + +;; This is the list of desktop environments supported as services. +(define %desktop-environments + (list + (desktop-environment + (name "GNOME") + (snippet '(gnome-desktop-service))) + (desktop-environment + (name "Xfce") + (snippet '(xfce-desktop-service))) + (desktop-environment + (name "MATE") + (snippet '(mate-desktop-service))) + (desktop-environment + (name "Enlightenment") + (snippet '(service enlightenment-desktop-service-type))))) + +(define (desktop-environments->configuration desktop-environments) + "Return the configuration field for DESKTOP-ENVIRONMENTS." + (let ((snippets + (map desktop-environment-snippet desktop-environments))) + `(,@(if (null? snippets) + '() + `((services (cons* ,@snippets + %desktop-services))))))) diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm new file mode 100644 index 0000000000..3f0bdad4f7 --- /dev/null +++ b/gnu/installer/steps.scm @@ -0,0 +1,237 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Mathieu Othacehe +;;; +;;; 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 . + +(define-module (gnu installer steps) + #:use-module (guix records) + #:use-module (guix build utils) + #:use-module (ice-9 match) + #:use-module (ice-9 pretty-print) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:use-module (rnrs io ports) + #:export (&installer-step-abort + installer-step-abort? + + &installer-step-break + installer-step-break? + + + installer-step + make-installer-step + installer-step? + installer-step-id + installer-step-description + installer-step-compute + installer-step-configuration-formatter + + run-installer-steps + find-step-by-id + result->step-ids + result-step + result-step-done? + + %installer-configuration-file + %installer-target-dir + %configuration-file-width + format-configuration + configuration->file)) + +;; This condition may be raised to abort the current step. +(define-condition-type &installer-step-abort &condition + installer-step-abort?) + +;; This condition may be raised to break out from the steps execution. +(define-condition-type &installer-step-break &condition + installer-step-break?) + +;; An installer-step record is basically an id associated to a compute +;; procedure. The COMPUTE procedure takes exactly one argument, an association +;; list containing the results of previously executed installer-steps (see +;; RUN-INSTALLER-STEPS description). The value returned by the COMPUTE +;; procedure will be stored in the results list passed to the next +;; installer-step and so on. +(define-record-type* + installer-step make-installer-step + installer-step? + (id installer-step-id) ;symbol + (description installer-step-description ;string + (default #f)) + (compute installer-step-compute) ;procedure + (configuration-formatter installer-step-configuration-formatter ;procedure + (default #f))) + +(define* (run-installer-steps #:key + steps + (rewind-strategy 'previous) + (menu-proc (const #f))) + "Run the COMPUTE procedure of all records in STEPS +sequencially. If the &installer-step-abort condition is raised, fallback to a +previous install-step, accordingly to the specified REWIND-STRATEGY. + +REWIND-STRATEGY possible values are 'previous, 'menu and 'start. If 'previous +is selected, the execution will resume at the previous installer-step. If +'menu is selected, the MENU-PROC procedure will be called. Its return value +has to be an installer-step ID to jump to. The ID has to be the one of a +previously executed step. It is impossible to jump forward. Finally if 'start +is selected, the execution will resume at the first installer-step. + +The result of every COMPUTE procedures is stored in an association list, under +the form: + + '((STEP-ID . COMPUTE-RESULT) ...) + +where STEP-ID is the ID field of the installer-step and COMPUTE-RESULT the +result of the associated COMPUTE procedure. This result association list is +passed as argument of every COMPUTE procedure. It is finally returned when the +computation is over. + +If the &installer-step-break condition is raised, stop the computation and +return the accumalated result so far." + (define (pop-result list) + (cdr list)) + + (define (first-step? steps step) + (match steps + ((first-step . rest-steps) + (equal? first-step step)))) + + (define* (skip-to-step step result + #:key todo-steps done-steps) + (match (list todo-steps done-steps) + (((todo . rest-todo) (prev-done ... last-done)) + (if (eq? (installer-step-id todo) + (installer-step-id step)) + (run result + #:todo-steps todo-steps + #:done-steps done-steps) + (skip-to-step step (pop-result result) + #:todo-steps (cons last-done todo-steps) + #:done-steps prev-done))))) + + (define* (run result #:key todo-steps done-steps) + (match todo-steps + (() (reverse result)) + ((step . rest-steps) + (guard (c ((installer-step-abort? c) + (case rewind-strategy + ((previous) + (match done-steps + (() + ;; We cannot go previous the first step. So re-raise + ;; the exception. It might be useful in the case of + ;; nested run-installer-steps. Abort to 'raise-above + ;; prompt to prevent the condition from being catched + ;; by one of the previously installed guard. + (abort-to-prompt 'raise-above c)) + ((prev-done ... last-done) + (run (pop-result result) + #:todo-steps (cons last-done todo-steps) + #:done-steps prev-done)))) + ((menu) + (let ((goto-step (menu-proc + (append done-steps (list step))))) + (if (eq? goto-step step) + (run result + #:todo-steps todo-steps + #:done-steps done-steps) + (skip-to-step goto-step result + #:todo-steps todo-steps + #:done-steps done-steps)))) + ((start) + (if (null? done-steps) + ;; Same as above, it makes no sense to jump to start + ;; when we are at the first installer-step. Abort to + ;; 'raise-above prompt to re-raise the condition. + (abort-to-prompt 'raise-above c) + (run '() + #:todo-steps steps + #:done-steps '()))))) + ((installer-step-break? c) + (reverse result))) + (let* ((id (installer-step-id step)) + (compute (installer-step-compute step)) + (res (compute result done-steps))) + (run (alist-cons id res result) + #:todo-steps rest-steps + #:done-steps (append done-steps (list step)))))))) + + (call-with-prompt 'raise-above + (lambda () + (run '() + #:todo-steps steps + #:done-steps '())) + (lambda (k condition) + (raise condition)))) + +(define (find-step-by-id steps id) + "Find and return the step in STEPS whose id is equal to ID." + (find (lambda (step) + (eq? (installer-step-id step) id)) + steps)) + +(define (result-step results step-id) + "Return the result of the installer-step specified by STEP-ID in +RESULTS." + (assoc-ref results step-id)) + +(define (result-step-done? results step-id) + "Return #t if the installer-step specified by STEP-ID has a COMPUTE value +stored in RESULTS. Return #f otherwise." + (and (assoc step-id results) #t)) + +(define %installer-configuration-file (make-parameter "/mnt/etc/config.scm")) +(define %installer-target-dir (make-parameter "/mnt")) +(define %configuration-file-width (make-parameter 79)) + +(define (format-configuration steps results) + "Return the list resulting from the application of the procedure defined in +CONFIGURATION-FORMATTER field of on the associated result +found in RESULTS." + (let ((configuration + (append-map + (lambda (step) + (let* ((step-id (installer-step-id step)) + (conf-formatter + (installer-step-configuration-formatter step)) + (result-step (result-step results step-id))) + (if (and result-step conf-formatter) + (conf-formatter result-step) + '()))) + steps)) + (modules '((use-modules (gnu)) + (use-service-modules desktop)))) + `(,@modules + () + (operating-system ,@configuration)))) + +(define* (configuration->file configuration + #:key (filename (%installer-configuration-file))) + "Write the given CONFIGURATION to FILENAME." + (mkdir-p (dirname filename)) + (call-with-output-file filename + (lambda (port) + (format port ";; This is an operating system configuration generated~%") + (format port ";; by the graphical installer.~%") + (newline port) + (for-each (lambda (part) + (if (null? part) + (newline port) + (pretty-print part port))) + configuration) + (flush-output-port port)))) diff --git a/gnu/installer/timezone.scm b/gnu/installer/timezone.scm new file mode 100644 index 0000000000..32bc2ed6bb --- /dev/null +++ b/gnu/installer/timezone.scm @@ -0,0 +1,127 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Mathieu Othacehe +;;; +;;; 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 . + +(define-module (gnu installer timezone) + #:use-module (gnu installer utils) + #:use-module (guix i18n) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:use-module (ice-9 match) + #:use-module (ice-9 receive) + #:export (locate-childrens + timezone->posix-tz + timezone-has-child? + zonetab->timezone-tree + posix-tz->configuration)) + +(define %not-blank + (char-set-complement char-set:blank)) + +(define (posix-tz->timezone tz) + "Convert given TZ in Posix format like \"Europe/Paris\" into a list like +(\"Europe\" \"Paris\")." + (string-split tz #\/)) + +(define (timezone->posix-tz timezone) + "Convert given TIMEZONE like (\"Europe\" \"Paris\") into a Posix timezone +like \"Europe/Paris\"." + (string-join timezone "/")) + +(define (zonetab->timezones zonetab) + "Parse ZONETAB file and return the corresponding list of timezones." + + (define (zonetab-line->posix-tz line) + (let ((tokens (string-tokenize line %not-blank))) + (match tokens + ((code coordinates tz _ ...) + tz)))) + + (call-with-input-file zonetab + (lambda (port) + (let* ((lines (read-lines port)) + ;; Filter comment lines starting with '#' character. + (tz-lines (filter (lambda (line) + (not (eq? (string-ref line 0) + #\#))) + lines))) + (map (lambda (line) + (posix-tz->timezone + (zonetab-line->posix-tz line))) + tz-lines))))) + +(define (timezones->timezone-tree timezones) + "Convert the list of timezones, TIMEZONES into a tree under the form: + + (\"America\" (\"North_Dakota\" \"New_Salem\" \"Center\")) + +representing America/North_Dakota/New_Salem and America/North_Dakota/Center +timezones." + + (define (remove-first lists) + "Remove the first element of every sublists in the argument LISTS." + (map (lambda (list) + (if (null? list) list (cdr list))) + lists)) + + (let loop ((cur-timezones timezones)) + (match cur-timezones + (() '()) + (((region . rest-region) . rest-timezones) + (if (null? rest-region) + (cons (list region) (loop rest-timezones)) + (receive (same-region other-region) + (partition (lambda (timezone) + (string=? (car timezone) region)) + cur-timezones) + (acons region + (loop (remove-first same-region)) + (loop other-region)))))))) + +(define (locate-childrens tree path) + "Return the childrens of the timezone indicated by PATH in the given +TREE. Raise a condition if the PATH could not be found." + (let ((extract-proc (cut map car <>))) + (match path + (() (sort (extract-proc tree) string (assoc-ref tree region) + (cut locate-childrens <> rest)) + (raise + (condition + (&message + (message + (format #f (G_ "Unable to locate path: ~a.") path)))))))))) + +(define (timezone-has-child? tree timezone) + "Return #t if the given TIMEZONE any child in TREE and #f otherwise." + (not (null? (locate-childrens tree timezone)))) + +(define* (zonetab->timezone-tree zonetab) + "Return the timezone tree corresponding to the given ZONETAB file." + (timezones->timezone-tree (zonetab->timezones zonetab))) + + +;;; +;;; Configuration formatter. +;;; + +(define (posix-tz->configuration timezone) + "Return the configuration field for TIMEZONE." + `((timezone ,timezone))) diff --git a/gnu/installer/user.scm b/gnu/installer/user.scm new file mode 100644 index 0000000000..1f8d40a011 --- /dev/null +++ b/gnu/installer/user.scm @@ -0,0 +1,50 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Mathieu Othacehe +;;; +;;; 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 . + +(define-module (gnu installer user) + #:use-module (guix records) + #:export ( + user + make-user + user-name + user-group + user-home-directory + + users->configuration)) + +(define-record-type* + user make-user + user? + (name user-name) + (group user-group + (default "users")) + (home-directory user-home-directory)) + +(define (users->configuration users) + "Return the configuration field for USERS." + `((users (cons* + ,@(map (lambda (user) + `(user-account + (name ,(user-name user)) + (group ,(user-group user)) + (home-directory ,(user-home-directory user)) + (supplementary-groups + (quote ("wheel" "netdev" + "audio" "video"))))) + users) + %base-user-accounts)))) diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm new file mode 100644 index 0000000000..e91f90a84d --- /dev/null +++ b/gnu/installer/utils.scm @@ -0,0 +1,63 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Mathieu Othacehe +;;; +;;; 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 . + +(define-module (gnu installer utils) + #:use-module (guix utils) + #:use-module (guix build utils) + #:use-module (ice-9 rdelim) + #:use-module (ice-9 regex) + #:use-module (ice-9 textual-ports) + #:export (read-lines + read-all + nearest-exact-integer + read-percentage + run-shell-command)) + +(define* (read-lines #:optional (port (current-input-port))) + "Read lines from PORT and return them as a list." + (let loop ((line (read-line port)) + (lines '())) + (if (eof-object? line) + (reverse lines) + (loop (read-line port) + (cons line lines))))) + +(define (read-all file) + "Return the content of the given FILE as a string." + (call-with-input-file file + get-string-all)) + +(define (nearest-exact-integer x) + "Given a real number X, return the nearest exact integer, with ties going to +the nearest exact even integer." + (inexact->exact (round x))) + +(define (read-percentage percentage) + "Read PERCENTAGE string and return the corresponding percentage as a +number. If no percentage is found, return #f" + (let ((result (string-match "^([0-9]+)%$" percentage))) + (and result + (string->number (match:substring result 1))))) + +(define (run-shell-command command) + (call-with-temporary-output-file + (lambda (file port) + (format port "~a~%" command) + ;; (format port "exit~%") + (close port) + (invoke "bash" "--init-file" file)))) diff --git a/gnu/local.mk b/gnu/local.mk index f4de1a44a4..5deae50336 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -46,6 +46,7 @@ GNU_SYSTEM_MODULES = \ %D%/bootloader/grub.scm \ %D%/bootloader/extlinux.scm \ %D%/bootloader/u-boot.scm \ + %D%/ci.scm \ %D%/packages.scm \ %D%/packages/abduco.scm \ %D%/packages/abiword.scm \ @@ -112,6 +113,7 @@ GNU_SYSTEM_MODULES = \ %D%/packages/conky.scm \ %D%/packages/connman.scm \ %D%/packages/cook.scm \ + %D%/packages/coq.scm \ %D%/packages/cpio.scm \ %D%/packages/cpp.scm \ %D%/packages/cppi.scm \ @@ -126,6 +128,7 @@ GNU_SYSTEM_MODULES = \ %D%/packages/datamash.scm \ %D%/packages/datastructures.scm \ %D%/packages/dav.scm \ + %D%/packages/dbm.scm \ %D%/packages/dc.scm \ %D%/packages/debian.scm \ %D%/packages/debug.scm \ @@ -154,6 +157,7 @@ GNU_SYSTEM_MODULES = \ %D%/packages/elixir.scm \ %D%/packages/embedded.scm \ %D%/packages/emacs.scm \ + %D%/packages/emacs-xyz.scm \ %D%/packages/emulators.scm \ %D%/packages/enchant.scm \ %D%/packages/engineering.scm \ @@ -348,6 +352,7 @@ GNU_SYSTEM_MODULES = \ %D%/packages/pem.scm \ %D%/packages/perl.scm \ %D%/packages/perl-check.scm \ + %D%/packages/perl-compression.scm \ %D%/packages/perl-web.scm \ %D%/packages/photo.scm \ %D%/packages/phabricator.scm \ @@ -366,8 +371,10 @@ GNU_SYSTEM_MODULES = \ %D%/packages/pure.scm \ %D%/packages/pv.scm \ %D%/packages/python.scm \ + %D%/packages/python-compression.scm \ %D%/packages/python-crypto.scm \ %D%/packages/python-web.scm \ + %D%/packages/python-xyz.scm \ %D%/packages/toys.scm \ %D%/packages/tryton.scm \ %D%/packages/qt.scm \ @@ -410,6 +417,7 @@ GNU_SYSTEM_MODULES = \ %D%/packages/sml.scm \ %D%/packages/speech.scm \ %D%/packages/spice.scm \ + %D%/packages/sqlite.scm \ %D%/packages/ssh.scm \ %D%/packages/sssd.scm \ %D%/packages/stalonetray.scm \ @@ -555,9 +563,47 @@ GNU_SYSTEM_MODULES = \ %D%/tests/ssh.scm \ %D%/tests/version-control.scm \ %D%/tests/virtualization.scm \ - %D%/tests/web.scm \ + %D%/tests/web.scm + +if ENABLE_INSTALLER + +GNU_SYSTEM_MODULES += \ + %D%/installer.scm \ + %D%/installer/connman.scm \ + %D%/installer/final.scm \ + %D%/installer/hostname.scm \ + %D%/installer/keymap.scm \ + %D%/installer/locale.scm \ + %D%/installer/newt.scm \ + %D%/installer/parted.scm \ + %D%/installer/record.scm \ + %D%/installer/services.scm \ + %D%/installer/steps.scm \ + %D%/installer/timezone.scm \ + %D%/installer/user.scm \ + %D%/installer/utils.scm \ \ - %D%/ci.scm + %D%/installer/newt/ethernet.scm \ + %D%/installer/newt/final.scm \ + %D%/installer/newt/hostname.scm \ + %D%/installer/newt/keymap.scm \ + %D%/installer/newt/locale.scm \ + %D%/installer/newt/menu.scm \ + %D%/installer/newt/network.scm \ + %D%/installer/newt/page.scm \ + %D%/installer/newt/partition.scm \ + %D%/installer/newt/services.scm \ + %D%/installer/newt/timezone.scm \ + %D%/installer/newt/utils.scm \ + %D%/installer/newt/welcome.scm \ + %D%/installer/newt/wifi.scm + +installerdir = $(guilemoduledir)/%D%/installer +dist_installer_DATA = \ + %D%/installer/aux-files/logo.txt \ + %D%/installer/aux-files/SUPPORTED + +endif ENABLE_INSTALLER # Modules that do not need to be compiled. MODULES_NOT_COMPILED += \ @@ -866,6 +912,7 @@ dist_patch_DATA = \ %D%/packages/patches/kinit-kdeinit-libpath.patch \ %D%/packages/patches/kio-search-smbd-on-PATH.patch \ %D%/packages/patches/kmod-module-directory.patch \ + %D%/packages/patches/kmscon-runtime-keymap-switch.patch \ %D%/packages/patches/kpackage-allow-external-paths.patch \ %D%/packages/patches/kobodeluxe-paths.patch \ %D%/packages/patches/kobodeluxe-enemies-pipe-decl.patch \ @@ -873,6 +920,7 @@ dist_patch_DATA = \ %D%/packages/patches/kobodeluxe-manpage-minus-not-hyphen.patch \ %D%/packages/patches/kobodeluxe-midicon-segmentation-fault.patch \ %D%/packages/patches/kobodeluxe-graphics-window-signed-char.patch \ + %D%/packages/patches/kodi-skip-test-449.patch \ %D%/packages/patches/laby-make-install.patch \ %D%/packages/patches/ldc-bootstrap-disable-tests.patch \ %D%/packages/patches/ldc-disable-phobos-tests.patch \ @@ -929,7 +977,6 @@ dist_patch_DATA = \ %D%/packages/patches/libsndfile-CVE-2017-8361-8363-8365.patch \ %D%/packages/patches/libsndfile-CVE-2017-8362.patch \ %D%/packages/patches/libsndfile-CVE-2017-12562.patch \ - %D%/packages/patches/libssh-hostname-parser-bug.patch \ %D%/packages/patches/libssh2-fix-build-failure-with-gcrypt.patch \ %D%/packages/patches/libtar-CVE-2013-4420.patch \ %D%/packages/patches/libtheora-config-guess.patch \ @@ -1029,11 +1076,13 @@ dist_patch_DATA = \ %D%/packages/patches/ola-readdir-r.patch \ %D%/packages/patches/openbabel-fix-crash-on-nwchem-output.patch \ %D%/packages/patches/opencascade-oce-glibc-2.26.patch \ + %D%/packages/patches/opencv-rgbd-aarch64-test-fix.patch \ %D%/packages/patches/openfoam-4.1-cleanup.patch \ %D%/packages/patches/openjdk-10-idlj-reproducibility.patch \ %D%/packages/patches/openldap-CVE-2017-9287.patch \ %D%/packages/patches/openocd-nrf52.patch \ %D%/packages/patches/opensmtpd-fix-crash.patch \ + %D%/packages/patches/openssh-CVE-2018-20685.patch \ %D%/packages/patches/openssl-runpath.patch \ %D%/packages/patches/openssl-1.1-c-rehash-in.patch \ %D%/packages/patches/openssl-c-rehash-in.patch \ diff --git a/gnu/packages.scm b/gnu/packages.scm index 532297239d..a1814205f9 100644 --- a/gnu/packages.scm +++ b/gnu/packages.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2013 Mark H Weaver ;;; Copyright © 2014 Eric Bavier ;;; Copyright © 2016, 2017 Alex Kost @@ -28,11 +28,14 @@ (define-module (gnu packages) #:use-module (guix memoization) #:use-module ((guix build utils) #:select ((package-name->name+version - . hyphen-separated-name->name+version))) + . hyphen-separated-name->name+version) + mkdir-p)) #:autoload (guix profiles) (packages->manifest) #:use-module (guix describe) #:use-module (ice-9 vlist) #:use-module (ice-9 match) + #:autoload (ice-9 binary-ports) (put-bytevector) + #:autoload (system base compile) (compile) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) @@ -50,14 +53,18 @@ (define-module (gnu packages) %default-package-module-path fold-packages + fold-available-packages find-packages-by-name + find-package-locations find-best-packages-by-name - find-newest-available-packages specification->package specification->package+output - specifications->manifest)) + specification->location + specifications->manifest + + generate-package-cache)) ;;; Commentary: ;;; @@ -136,6 +143,14 @@ (define %default-package-module-path ;; Default search path for package modules. `((,%distro-root-directory . "gnu/packages"))) +(define (cache-is-authoritative?) + "Return true if the pre-computed package cache is authoritative. It is not +authoritative when entries have been added via GUIX_PACKAGE_PATH or '-L' +flags." + (equal? (%package-module-path) + (append %default-package-module-path + (package-path-entries)))) + (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 @@ -168,6 +183,50 @@ (define %patch-path directory)) %load-path))) +(define (fold-available-packages proc init) + "Fold PROC over the list of available packages. For each available package, +PROC is called along these lines: + + (PROC NAME VERSION RESULT + #:outputs OUTPUTS + #:location LOCATION + …) + +PROC can use #:allow-other-keys to ignore the bits it's not interested in. +When a package cache is available, this procedure does not actually load any +package module." + (define cache + (load-package-cache (current-profile))) + + (if (and cache (cache-is-authoritative?)) + (vhash-fold (lambda (name vector result) + (match vector + (#(name version module symbol outputs + supported? deprecated? + file line column) + (proc name version result + #:outputs outputs + #:location (and file + (location file line column)) + #:supported? supported? + #:deprecated? deprecated?)))) + init + cache) + (fold-packages (lambda (package result) + (proc (package-name package) + (package-version package) + result + #:outputs (package-outputs package) + #:location (package-location package) + #:supported? + (->bool + (member (%current-system) + (package-supported-systems package))) + #:deprecated? + (->bool + (package-superseded package)))) + init))) + (define* (fold-packages proc init #:optional (modules (all-modules (%package-module-path) @@ -184,7 +243,35 @@ (define* (fold-packages proc init init modules)) -(define find-packages-by-name +(define %package-cache-file + ;; Location of the package cache. + "/lib/guix/package.cache") + +(define load-package-cache + (mlambda (profile) + "Attempt to load the package cache. On success return a vhash keyed by +package names. Return #f on failure." + (match profile + (#f #f) + (profile + (catch 'system-error + (lambda () + (define lst + (load-compiled (string-append profile %package-cache-file))) + (fold (lambda (item vhash) + (match item + (#(name version module symbol outputs + supported? deprecated? + file line column) + (vhash-cons name item vhash)))) + vlist-null + lst)) + (lambda args + (if (= ENOENT (system-error-errno args)) + #f + (apply throw args)))))))) + +(define find-packages-by-name/direct ;bypass the cache (let ((packages (delay (fold-packages (lambda (p r) (vhash-cons (package-name p) p r)) @@ -203,28 +290,61 @@ (define find-packages-by-name matching) matching))))) -(define find-newest-available-packages - (mlambda () - "Return a vhash keyed by package names, and with -associated values of the form +(define (cache-lookup cache name) + "Lookup package NAME in CACHE. Return a list sorted in increasing version +order." + (define (package-version? (vector-ref v2 1) (vector-ref v1 1))) - (newest-version newest-package ...) + (sort (vhash-fold* cons '() name cache) + package-version) (vhash-cons name `(,version ,p) r)) - ((=) (vhash-cons name `(,version ,p ,@pkgs) r)) - ((<) r))) - (#f (vhash-cons name `(,version ,p) r))))) - vlist-null))) + (if (and (cache-is-authoritative?) cache) + (match (cache-lookup cache name) + (#f #f) + ((#(_ versions modules symbols _ _ _ _ _ _) ...) + (fold (lambda (version* module symbol result) + (if (or (not version) + (version-prefix? version version*)) + (cons (module-ref (resolve-interface module) + symbol) + result) + result)) + '() + versions modules symbols))) + (find-packages-by-name/direct name version))) + +(define* (find-package-locations name #:optional version) + "Return a list of version/location pairs corresponding to each package +matching NAME and VERSION." + (define cache + (load-package-cache (current-profile))) + + (if (and cache (cache-is-authoritative?)) + (match (cache-lookup cache name) + (#f '()) + ((#(name versions modules symbols outputs + supported? deprecated? + files lines columns) ...) + (fold (lambda (version* file line column result) + (if (and file + (or (not version) + (version-prefix? version version*))) + (alist-cons version* (location file line column) + result) + result)) + '() + versions files lines columns))) + (map (lambda (package) + (cons (package-version package) (package-location package))) + (find-packages-by-name/direct name version)))) (define (find-best-packages-by-name name version) "If version is #f, return the list of packages named NAME with the highest @@ -232,9 +352,64 @@ (define (find-best-packages-by-name name version) VERSION." (if version (find-packages-by-name name version) - (match (vhash-assoc name (find-newest-available-packages)) - ((_ version pkgs ...) pkgs) - (#f '())))) + (match (find-packages-by-name name) + (() + '()) + ((matches ...) + ;; Return the subset of MATCHES with the higher version number. + (let ((highest (package-version (first matches)))) + (take-while (lambda (p) + (string=? (package-version p) highest)) + matches)))))) + +(define (generate-package-cache directory) + "Generate under DIRECTORY a cache of all the available packages. + +The primary purpose of the cache is to speed up package lookup by name such +that we don't have to traverse and load all the package modules, thereby also +reducing the memory footprint." + (define cache-file + (string-append directory %package-cache-file)) + + (define (expand-cache module symbol variable result) + (match (false-if-exception (variable-ref variable)) + ((? package? package) + (if (hidden-package? package) + result + (cons `#(,(package-name package) + ,(package-version package) + ,(module-name module) + ,symbol + ,(package-outputs package) + ,(->bool (member (%current-system) + (package-supported-systems package))) + ,(->bool (package-superseded package)) + ,@(let ((loc (package-location package))) + (if loc + `(,(location-file loc) + ,(location-line loc) + ,(location-column loc)) + '(#f #f #f)))) + result))) + (_ + result))) + + (define exp + (fold-module-public-variables* expand-cache '() + (all-modules (%package-module-path) + #:warn + warn-about-load-error))) + + (mkdir-p (dirname cache-file)) + (call-with-output-file cache-file + (lambda (port) + ;; Store the cache as a '.go' file. This makes loading fast and reduces + ;; heap usage since some of the static data is directly mmapped. + (put-bytevector port + (compile `'(,@exp) + #:to 'bytecode + #:opts '(#:to-file? #t))))) + cache-file) (define %sigint-prompt @@ -290,6 +465,30 @@ (define (specification->package spec) (let-values (((name version) (package-name->name+version spec))) (%find-package spec name version))) +(define (specification->location spec) + "Return the location of the highest-numbered package matching SPEC, a +specification such as \"guile@2\" or \"emacs\"." + (let-values (((name version) (package-name->name+version spec))) + (match (find-package-locations name version) + (() + (if version + (leave (G_ "~A: package not found for version ~a~%") name version) + (leave (G_ "~A: unknown package~%") name))) + (lst + (let* ((highest (match lst (((version . _) _ ...) version))) + (locations (take-while (match-lambda + ((version . location) + (string=? version highest))) + lst))) + (match locations + (((version . location) . rest) + (unless (null? rest) + (warning (G_ "ambiguous package specification `~a'~%") spec) + (warning (G_ "choosing ~a@~a from ~a~%") + name version + (location->string location))) + location))))))) + (define* (specification->package+output spec #:optional (output "out")) "Return the package and output specified by SPEC, or #f and #f; SPEC may optionally contain a version number and an output name, as in these examples: diff --git a/gnu/packages/ada.scm b/gnu/packages/ada.scm index d60723edfa..a8c2bdc9a9 100644 --- a/gnu/packages/ada.scm +++ b/gnu/packages/ada.scm @@ -26,7 +26,8 @@ (define-module (gnu packages ada) #:use-module (gnu packages) #:use-module (gnu packages check) #:use-module (gnu packages compression) - #:use-module (gnu packages python)) + #:use-module (gnu packages python) + #:use-module (gnu packages python-xyz)) (define-public python2-langkit (let ((commit "fe0bc8bf60dbd2937759810df76ac420d99fc15f") diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm index 5ad3f6d873..815ce19718 100644 --- a/gnu/packages/admin.scm +++ b/gnu/packages/admin.scm @@ -13,7 +13,7 @@ ;;; Copyright © 2016 Peter Feigl ;;; Copyright © 2016 John J. Foerch ;;; Copyright © 2016, 2017 Nils Gillmann -;;; Copyright © 2016, 2017, 2018 Tobias Geerinckx-Rice +;;; Copyright © 2016, 2017, 2018, 2019 Tobias Geerinckx-Rice ;;; Copyright © 2016 John Darrington ;;; Copyright © 2017 Ben Sturmfels ;;; Copyright © 2017 Ethan R. Jones @@ -86,6 +86,7 @@ (define-module (gnu packages admin) #:use-module (gnu packages python) #:use-module (gnu packages python-crypto) #:use-module (gnu packages python-web) + #:use-module (gnu packages python-xyz) #:use-module (gnu packages qt) #:use-module (gnu packages terminals) #:use-module (gnu packages texinfo) @@ -1510,7 +1511,7 @@ (define-public libcap-ng (define-public smartmontools (package (name "smartmontools") - (version "6.6") + (version "7.0") (source (origin (method url-fetch) (uri (string-append @@ -1518,7 +1519,7 @@ (define-public smartmontools version "/smartmontools-" version ".tar.gz")) (sha256 (base32 - "0m1hllbb78rr6cxkbalmz1gqkl0psgq8rrmv4gwcmz34n07kvx2i")))) + "077nx2rn9szrg6isdh0938zbp7vr3dsyxl4jdyyzv1xwhqksrqg5")))) (build-system gnu-build-system) (inputs `(("libcap-ng" ,libcap-ng))) (home-page "https://www.smartmontools.org/") diff --git a/gnu/packages/adns.scm b/gnu/packages/adns.scm index 6e3af8b2d3..28a65667eb 100644 --- a/gnu/packages/adns.scm +++ b/gnu/packages/adns.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 Ludovic Courtès ;;; Copyright © 2015, 2016, 2018 Efraim Flashner +;;; Copyright © 2018 Ricardo Wurmus ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,6 +22,7 @@ (define-module (gnu packages adns) #:use-module (guix licenses) #:use-module (guix packages) #:use-module (guix download) + #:use-module (guix build-system cmake) #:use-module (guix build-system gnu) #:use-module (gnu packages pkg-config)) @@ -80,3 +82,33 @@ (define-public c-ares The primary examples of such applications are servers which communicate with multiple clients and programs with graphical user interfaces.") (license (x11-style "https://c-ares.haxx.se/license.html")))) + +;; XXX: temporary package for tensorflow / grpc +(define-public c-ares-next + (package + (name "c-ares") + (version "1.15.0") + (source (origin + (method url-fetch) + (uri (string-append + "https://c-ares.haxx.se/download/" name "-" version + ".tar.gz")) + (sha256 + (base32 + "0lk8knip4xk6qzksdkn7085mmgm4ixfczdyyjw656c193y3rgnvc")))) + (build-system cmake-build-system) + (arguments + `(#:tests? #f ; some tests seem to require Internet connection + #:configure-flags + (list "-DCARES_BUILD_TESTS=ON"))) + (native-inputs + `(("pkg-config" ,pkg-config))) + (home-page "https://c-ares.haxx.se/") + (synopsis "C library for asynchronous DNS requests") + (description + "C-ares is a C library that performs DNS requests and name resolution +asynchronously. It is intended for applications which need to perform DNS +queries without blocking, or need to perform multiple DNS queries in parallel. +The primary examples of such applications are servers which communicate with +multiple clients and programs with graphical user interfaces.") + (license (x11-style "https://c-ares.haxx.se/license.html")))) diff --git a/gnu/packages/android.scm b/gnu/packages/android.scm index 48380740a3..d5a60cb5bb 100644 --- a/gnu/packages/android.scm +++ b/gnu/packages/android.scm @@ -41,6 +41,7 @@ (define-module (gnu packages android) #:use-module (gnu packages python) #:use-module (gnu packages python-crypto) #:use-module (gnu packages python-web) + #:use-module (gnu packages python-xyz) #:use-module (gnu packages selinux) #:use-module (gnu packages serialization) #:use-module (gnu packages ssh) diff --git a/gnu/packages/animation.scm b/gnu/packages/animation.scm index a10747ef38..965fff6d46 100644 --- a/gnu/packages/animation.scm +++ b/gnu/packages/animation.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015, 2017 Ricardo Wurmus ;;; Copyright © 2018 Tobias Geerinckx-Rice +;;; Copyright © 2019 Pkill -9 ;;; ;;; This file is part of GNU Guix. ;;; @@ -258,3 +259,44 @@ (define-public papagayo type in the words being spoken, then drag the words on top of the sound’s waveform until they line up with the proper sounds.") (license license:gpl3+)))) + +(define-public pencil2d + (package + (name "pencil2d") + (version "0.6.2") + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/pencil2d/pencil") + (commit (string-append "v" version)))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "1iv7drwxs32mqs3hybjx2lxyqn8cv2b4rw9ny7gzdacsbhi65knr")))) + (build-system gnu-build-system) + (inputs + `(("qtbase" ,qtbase) + ("qtxmlpatterns" ,qtxmlpatterns) + ("qtmultimedia" ,qtmultimedia) + ("qtsvg" ,qtsvg))) + (arguments + `(#:phases + (modify-phases %standard-phases + (replace 'configure + (lambda* (#:key inputs outputs #:allow-other-keys) + (let ((out (assoc-ref outputs "out"))) + (invoke "qmake" (string-append "PREFIX=" out))))) + (add-after 'install 'wrap-executable + (lambda* (#:key inputs outputs #:allow-other-keys) + (let ((out (assoc-ref outputs "out")) + (plugin-path (getenv "QT_PLUGIN_PATH"))) + (wrap-program (string-append out "/bin/pencil2d") + `("QT_PLUGIN_PATH" ":" prefix (,plugin-path))) + #t)))))) + (home-page "https://www.pencil2d.org") + (synopsis "Make 2D hand-drawn animations") + (description + "Pencil2D is an easy-to-use and intuitive animation and drawing tool. It +lets you create traditional hand-drawn animations (cartoons) using both bitmap +and vector graphics.") + (license license:gpl2))) diff --git a/gnu/packages/apl.scm b/gnu/packages/apl.scm index aa47edcd64..88150dc4d0 100644 --- a/gnu/packages/apl.scm +++ b/gnu/packages/apl.scm @@ -25,8 +25,8 @@ (define-module (gnu packages apl) #: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)) + #:use-module (gnu packages readline) + #:use-module (gnu packages sqlite)) (define-public apl (package diff --git a/gnu/packages/audio.scm b/gnu/packages/audio.scm index 80aacc5664..658f23e45d 100644 --- a/gnu/packages/audio.scm +++ b/gnu/packages/audio.scm @@ -8,7 +8,7 @@ ;;; Copyright © 2016, 2017 Alex Griffin ;;; Copyright © 2016 Nils Gillmann ;;; Copyright © 2016 Lukas Gradl -;;; Copyright © 2016, 2017, 2018 Tobias Geerinckx-Rice +;;; Copyright © 2016, 2017, 2018, 2019 Tobias Geerinckx-Rice ;;; Copyright © 2018 Oleg Pykhalov ;;; Copyright © 2018 okapi ;;; Copyright © 2018 Maxim Cournoyer @@ -18,6 +18,7 @@ ;;; Copyright © 2018 Thorsten Wilms ;;; Copyright © 2018 Eric Bavier ;;; Copyright © 2018 Brendan Tildesley +;;; Copyright © 2019 Pierre Langlois ;;; ;;; This file is part of GNU Guix. ;;; @@ -57,7 +58,7 @@ (define-module (gnu packages audio) #:use-module (gnu packages check) #:use-module (gnu packages compression) #:use-module (gnu packages curl) - #:use-module (gnu packages databases) + #:use-module (gnu packages dbm) #:use-module (gnu packages emacs) #:use-module (gnu packages file) #:use-module (gnu packages flex) @@ -82,6 +83,7 @@ (define-module (gnu packages audio) #:use-module (gnu packages pkg-config) #:use-module (gnu packages pulseaudio) ;libsndfile, libsamplerate #:use-module (gnu packages python) + #:use-module (gnu packages python-xyz) #:use-module (gnu packages rdf) #:use-module (gnu packages readline) #:use-module (gnu packages serialization) @@ -761,7 +763,7 @@ (define-public swh-plugins-lv2 (define-public csound (package (name "csound") - (version "6.11.0") + (version "6.12.0") (source (origin (method git-fetch) (uri (git-reference @@ -770,7 +772,7 @@ (define-public csound (file-name (git-file-name name version)) (sha256 (base32 - "1hlkrnv3gghx4v382nl6v6k2k1dzm5ddk35m5g3q6pzc959726s7")))) + "0pv4s54cayvavdp6y30n3r1l5x83x9whyyd2v24y0dh224v3hbxi")))) (build-system cmake-build-system) (inputs `(("alsa-lib" ,alsa-lib) @@ -2154,7 +2156,11 @@ (define-public qjackctl "1rzzqa39a6llr52vjkjr0a86nc776kmr5xs52qqga8ms9697psz5")))) (build-system gnu-build-system) (arguments - '(#:tests? #f)) ; no check target + '(#:tests? #f ;; no check target + ;; Disable xunique to prevent X hanging when starting qjackctl in + ;; tiling window managers such as StumpWM or i3 + ;; (see https://github.com/rncbc/qjackctl/issues/13). + #:configure-flags '("--disable-xunique"))) (inputs `(("jack" ,jack-1) ("alsa-lib" ,alsa-lib) diff --git a/gnu/packages/avahi.scm b/gnu/packages/avahi.scm index df74437631..e71ffc2982 100644 --- a/gnu/packages/avahi.scm +++ b/gnu/packages/avahi.scm @@ -24,7 +24,7 @@ (define-module (gnu packages avahi) #:use-module (guix download) #:use-module (guix build-system gnu) #:use-module (gnu packages) - #:use-module (gnu packages databases) + #:use-module (gnu packages dbm) #:use-module (gnu packages libdaemon) #:use-module (gnu packages linux) #:use-module (gnu packages pkg-config) diff --git a/gnu/packages/backup.scm b/gnu/packages/backup.scm index 4a8355f2b1..5d9013552e 100644 --- a/gnu/packages/backup.scm +++ b/gnu/packages/backup.scm @@ -46,6 +46,7 @@ (define-module (gnu packages backup) #:use-module (gnu packages compression) #:use-module (gnu packages crypto) #:use-module (gnu packages databases) + #:use-module (gnu packages dbm) #:use-module (gnu packages dejagnu) #:use-module (gnu packages ftp) #:use-module (gnu packages glib) @@ -62,6 +63,7 @@ (define-module (gnu packages backup) #:use-module (gnu packages python) #:use-module (gnu packages python-crypto) #:use-module (gnu packages python-web) + #:use-module (gnu packages python-xyz) #:use-module (gnu packages rsync) #:use-module (gnu packages ssh) #:use-module (gnu packages tls) diff --git a/gnu/packages/benchmark.scm b/gnu/packages/benchmark.scm index 9d792021bd..e97e827cea 100644 --- a/gnu/packages/benchmark.scm +++ b/gnu/packages/benchmark.scm @@ -29,6 +29,7 @@ (define-module (gnu packages benchmark) #:use-module (gnu packages maths) #:use-module (gnu packages mpi) #:use-module (gnu packages python) + #:use-module (gnu packages python-xyz) #:use-module (gnu packages storage) #:use-module (ice-9 match)) diff --git a/gnu/packages/bioconductor.scm b/gnu/packages/bioconductor.scm index 37ac94128b..20aabb0be4 100644 --- a/gnu/packages/bioconductor.scm +++ b/gnu/packages/bioconductor.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018, 2019 Ricardo Wurmus -;;; Copyright © 2018 Roel Janssen +;;; Copyright © 2017, 2018 Roel Janssen ;;; Copyright © 2018 Tobias Geerinckx-Rice ;;; ;;; This file is part of GNU Guix. @@ -228,6 +228,53 @@ (define-public r-txdb-mmusculus-ucsc-mm9-knowngene (license license:artistic2.0))) +(define-public r-biocgenerics + (package + (name "r-biocgenerics") + (version "0.28.0") + (source (origin + (method url-fetch) + (uri (bioconductor-uri "BiocGenerics" version)) + (sha256 + (base32 + "0cvpsrhg7sn7lpqgxvqrsagv6j7xj5rafq5xdjfd8zc4gxrs5rb8")))) + (properties + `((upstream-name . "BiocGenerics"))) + (build-system r-build-system) + (home-page "https://bioconductor.org/packages/BiocGenerics") + (synopsis "S4 generic functions for Bioconductor") + (description + "This package provides S4 generic functions needed by many Bioconductor +packages.") + (license license:artistic2.0))) + +(define-public r-annotate + (package + (name "r-annotate") + (version "1.60.0") + (source + (origin + (method url-fetch) + (uri (bioconductor-uri "annotate" version)) + (sha256 + (base32 + "0p6c96lay23a67dyirgnwzm2yw22m592z780vy6p4nqwla8ha18n")))) + (build-system r-build-system) + (propagated-inputs + `(("r-annotationdbi" ,r-annotationdbi) + ("r-biobase" ,r-biobase) + ("r-biocgenerics" ,r-biocgenerics) + ("r-dbi" ,r-dbi) + ("r-rcurl" ,r-rcurl) + ("r-xml" ,r-xml) + ("r-xtable" ,r-xtable))) + (home-page + "https://bioconductor.org/packages/annotate") + (synopsis "Annotation for microarrays") + (description "This package provides R environments for the annotation of +microarrays.") + (license license:artistic2.0))) + (define-public r-hpar (package (name "r-hpar") diff --git a/gnu/packages/bioinformatics.scm b/gnu/packages/bioinformatics.scm index 42f5c3b80d..28dbdca13b 100644 --- a/gnu/packages/bioinformatics.scm +++ b/gnu/packages/bioinformatics.scm @@ -98,7 +98,9 @@ (define-module (gnu packages bioinformatics) #:use-module (gnu packages popt) #:use-module (gnu packages protobuf) #:use-module (gnu packages python) + #:use-module (gnu packages python-compression) #:use-module (gnu packages python-web) + #:use-module (gnu packages python-xyz) #:use-module (gnu packages readline) #:use-module (gnu packages ruby) #:use-module (gnu packages serialization) @@ -6338,63 +6340,6 @@ (define-public r-centipede information as possible.") (license (list license:gpl2+ license:gpl3+)))) -(define-public r-vegan - (package - (name "r-vegan") - (version "2.5-3") - (source - (origin - (method url-fetch) - (uri (cran-uri "vegan" version)) - (sha256 - (base32 - "023xznh0iy0496icpchadmp7a3rk3nj9s48fvwlvp3dssw58yp3c")))) - (build-system r-build-system) - (native-inputs - `(("gfortran" ,gfortran))) - (propagated-inputs - `(("r-cluster" ,r-cluster) - ("r-knitr" ,r-knitr) ; needed for vignettes - ("r-lattice" ,r-lattice) - ("r-mass" ,r-mass) - ("r-mgcv" ,r-mgcv) - ("r-permute" ,r-permute))) - (home-page "https://cran.r-project.org/web/packages/vegan") - (synopsis "Functions for community ecology") - (description - "The vegan package provides tools for descriptive community ecology. It -has most basic functions of diversity analysis, community ordination and -dissimilarity analysis. Most of its multivariate tools can be used for other -data types as well.") - (license license:gpl2+))) - -(define-public r-annotate - (package - (name "r-annotate") - (version "1.60.0") - (source - (origin - (method url-fetch) - (uri (bioconductor-uri "annotate" version)) - (sha256 - (base32 - "0p6c96lay23a67dyirgnwzm2yw22m592z780vy6p4nqwla8ha18n")))) - (build-system r-build-system) - (propagated-inputs - `(("r-annotationdbi" ,r-annotationdbi) - ("r-biobase" ,r-biobase) - ("r-biocgenerics" ,r-biocgenerics) - ("r-dbi" ,r-dbi) - ("r-rcurl" ,r-rcurl) - ("r-xml" ,r-xml) - ("r-xtable" ,r-xtable))) - (home-page - "https://bioconductor.org/packages/annotate") - (synopsis "Annotation for microarrays") - (description "This package provides R environments for the annotation of -microarrays.") - (license license:artistic2.0))) - (define-public r-copynumber (package (name "r-copynumber") @@ -7092,26 +7037,6 @@ (define-public r-acsnminer barplots or heatmaps.") (license license:gpl2+))) -(define-public r-biocgenerics - (package - (name "r-biocgenerics") - (version "0.28.0") - (source (origin - (method url-fetch) - (uri (bioconductor-uri "BiocGenerics" version)) - (sha256 - (base32 - "0cvpsrhg7sn7lpqgxvqrsagv6j7xj5rafq5xdjfd8zc4gxrs5rb8")))) - (properties - `((upstream-name . "BiocGenerics"))) - (build-system r-build-system) - (home-page "https://bioconductor.org/packages/BiocGenerics") - (synopsis "S4 generic functions for Bioconductor") - (description - "This package provides S4 generic functions needed by many Bioconductor -packages.") - (license license:artistic2.0))) - (define-public r-biocinstaller (package (name "r-biocinstaller") diff --git a/gnu/packages/bittorrent.scm b/gnu/packages/bittorrent.scm index ee094a4814..00b115cb9c 100644 --- a/gnu/packages/bittorrent.scm +++ b/gnu/packages/bittorrent.scm @@ -41,7 +41,6 @@ (define-module (gnu packages bittorrent) #:use-module (gnu packages crypto) #:use-module (gnu packages curl) #:use-module (gnu packages cyrus-sasl) - #:use-module (gnu packages databases) #:use-module (gnu packages file) #:use-module (gnu packages freedesktop) #:use-module (gnu packages glib) @@ -57,7 +56,9 @@ (define-module (gnu packages bittorrent) #:use-module (gnu packages pkg-config) #:use-module (gnu packages python) #:use-module (gnu packages python-crypto) + #:use-module (gnu packages python-xyz) #:use-module (gnu packages qt) + #:use-module (gnu packages sqlite) #:use-module (gnu packages ssh) #:use-module (gnu packages tls) #:use-module (gnu packages xml)) diff --git a/gnu/packages/bootloaders.scm b/gnu/packages/bootloaders.scm index 69b4a904be..a4b4f64783 100644 --- a/gnu/packages/bootloaders.scm +++ b/gnu/packages/bootloaders.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2015, 2018 Mark H Weaver ;;; Copyright © 2015 Leo Famulari ;;; Copyright © 2016 Jan Nieuwenhuizen @@ -8,6 +8,7 @@ ;;; Copyright © 2016, 2017 David Craven ;;; Copyright © 2017, 2018 Efraim Flashner ;;; Copyright © 2018 Tobias Geerinckx-Rice +;;; Copyright © 2019 nee ;;; ;;; This file is part of GNU Guix. ;;; @@ -55,6 +56,7 @@ (define-module (gnu packages bootloaders) #:use-module (gnu packages swig) #:use-module (gnu packages valgrind) #:use-module (gnu packages virtualization) + #:use-module (gnu packages xorg) #:use-module (gnu packages web) #:use-module (guix build-system gnu) #:use-module (guix download) @@ -110,6 +112,12 @@ (define-public grub ;; Make the font visible. (copy-file (assoc-ref inputs "unifont") "unifont.bdf.gz") (system* "gunzip" "unifont.bdf.gz") + + ;; Give the absolute file name of 'ckbcomp'. + (substitute* "util/grub-kbdcomp.in" + (("^ckbcomp ") + (string-append (assoc-ref inputs "console-setup") + "/bin/ckbcomp "))) #t)) (add-before 'check 'disable-flaky-test (lambda _ @@ -134,6 +142,10 @@ (define-public grub ;; to determine whether the root file system is RAID. ("mdadm" ,mdadm) + ;; Console-setup's ckbcomp is invoked by grub-kbdcomp. It is required + ;; for generating alternative keyboard layouts. + ("console-setup" ,console-setup) + ("freetype" ,freetype) ;; ("libusb" ,libusb) ;; ("fuse" ,fuse) @@ -717,7 +729,14 @@ (define-public vboot-utils ".drv-0/source"))) ;; Tests require write permissions to many of these files. (for-each make-file-writable (find-files "tests/futility")) - #t))) + #t)) + (add-after 'install 'install-devkeys + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (share (string-append out "/share/vboot-utils"))) + (copy-recursively "tests/devkeys" + (string-append share "/devkeys")) + #t)))) #:test-target "runtests")) (native-inputs `(("pkg-config" ,pkg-config) diff --git a/gnu/packages/calendar.scm b/gnu/packages/calendar.scm index ccf26a2aea..f1949c14c0 100644 --- a/gnu/packages/calendar.scm +++ b/gnu/packages/calendar.scm @@ -32,7 +32,6 @@ (define-module (gnu packages calendar) #:use-module (guix build-system python) #:use-module (gnu packages base) #:use-module (gnu packages check) - #:use-module (gnu packages databases) #:use-module (gnu packages dav) #:use-module (gnu packages freedesktop) #:use-module (gnu packages glib) @@ -40,6 +39,8 @@ (define-module (gnu packages calendar) #:use-module (gnu packages perl) #:use-module (gnu packages pkg-config) #:use-module (gnu packages python) + #:use-module (gnu packages python-xyz) + #:use-module (gnu packages sqlite) #:use-module (gnu packages time) #:use-module (gnu packages xml) #:use-module (srfi srfi-26)) diff --git a/gnu/packages/check.scm b/gnu/packages/check.scm index dc2bda5480..439a668dd7 100644 --- a/gnu/packages/check.scm +++ b/gnu/packages/check.scm @@ -47,13 +47,20 @@ (define-module (gnu packages check) #:use-module (gnu packages) #:use-module (gnu packages autotools) + #:use-module (gnu packages base) #:use-module (gnu packages bash) #:use-module (gnu packages compression) + #:use-module (gnu packages linux) #:use-module (gnu packages llvm) + #:use-module (gnu packages glib) + #:use-module (gnu packages gnome) #:use-module (gnu packages golang) + #:use-module (gnu packages gtk) #:use-module (gnu packages perl) + #:use-module (gnu packages pkg-config) #:use-module (gnu packages python) #:use-module (gnu packages python-web) + #:use-module (gnu packages python-xyz) #:use-module (gnu packages time) #:use-module (guix utils) #:use-module ((guix licenses) #:prefix license:) @@ -2153,3 +2160,45 @@ (define-public libfaketime @code{LD_PRELOAD} environment variable. The @command{faketime} command provides a simple way to achieve this.") (license license:gpl2))) + +(define-public umockdev + (package + (name "umockdev") + (version "0.11.3") + (source (origin + (method url-fetch) + (uri (string-append "https://github.com/martinpitt/umockdev/" + "releases/download/" version "/" + "umockdev-" version ".tar.xz")) + (sha256 + (base32 + "1in2hdan1g62wpvgjlj8mci85551ipr1964j2b9j06gm3blpihcx")))) + (build-system gnu-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-after 'unpack 'skip-broken-test + (lambda _ + (substitute* "tests/test-umockdev.c" + (("/\\* sys/ in other dir") + (string-append "return; // "))) + #t))))) + (native-inputs + `(("vala" ,vala) + ("python" ,python) ; for tests + ("which" ,which) ; for tests + ("gtk-doc" ,gtk-doc) + ("pkg-config" ,pkg-config))) + (inputs + `(("glib" ,glib) + ("eudev" ,eudev) + ("libgudev" ,libgudev) + ("gobject-introspection" ,gobject-introspection))) + (home-page "https://github.com/martinpitt/umockdev/") + (synopsis "Mock hardware devices for creating unit tests") + (description "umockdev mocks hardware devices for creating integration +tests for hardware related libraries and programs. It also provides tools to +record the properties and behaviour of particular devices, and to run a +program or test suite under a test bed with the previously recorded devices +loaded.") + (license license:lgpl2.1+))) diff --git a/gnu/packages/chemistry.scm b/gnu/packages/chemistry.scm index e682975b36..a493af16f5 100644 --- a/gnu/packages/chemistry.scm +++ b/gnu/packages/chemistry.scm @@ -33,6 +33,7 @@ (define-module (gnu packages chemistry) #:use-module (gnu packages maths) #:use-module (gnu packages pkg-config) #:use-module (gnu packages python) + #:use-module (gnu packages python-xyz) #:use-module (gnu packages qt) #:use-module (gnu packages xml) #:use-module (guix build-system cmake) diff --git a/gnu/packages/ci.scm b/gnu/packages/ci.scm index 30d86bd09f..bd4a3d3509 100644 --- a/gnu/packages/ci.scm +++ b/gnu/packages/ci.scm @@ -36,6 +36,7 @@ (define-module (gnu packages ci) #:use-module (gnu packages mail) #:use-module (gnu packages package-management) #:use-module (gnu packages perl) + #:use-module (gnu packages perl-compression) #:use-module (gnu packages pkg-config) #:use-module (gnu packages tls) #:use-module (gnu packages texinfo) diff --git a/gnu/packages/cluster.scm b/gnu/packages/cluster.scm index 3d75e84440..8d6669cd22 100644 --- a/gnu/packages/cluster.scm +++ b/gnu/packages/cluster.scm @@ -24,7 +24,7 @@ (define-module (gnu packages cluster) #:use-module (guix packages) #:use-module (gnu packages linux) #:use-module (gnu packages pkg-config) - #:use-module (gnu packages python) + #:use-module (gnu packages python-xyz) #:use-module (gnu packages texinfo) #:use-module (gnu packages tls)) diff --git a/gnu/packages/cobol.scm b/gnu/packages/cobol.scm index 75c8c53bbe..257527e3b8 100644 --- a/gnu/packages/cobol.scm +++ b/gnu/packages/cobol.scm @@ -22,7 +22,7 @@ (define-module (gnu packages cobol) #:use-module (guix licenses) #:use-module (guix packages) #:use-module (guix download) - #:use-module (gnu packages databases) + #:use-module (gnu packages dbm) #:use-module (gnu packages multiprecision) #:use-module (gnu packages ncurses) #:use-module (gnu packages perl)) diff --git a/gnu/packages/code.scm b/gnu/packages/code.scm index 357125d047..3a575ad380 100644 --- a/gnu/packages/code.scm +++ b/gnu/packages/code.scm @@ -42,7 +42,6 @@ (define-module (gnu packages code) #:use-module (gnu packages bash) #:use-module (gnu packages compression) #:use-module (gnu packages cpp) - #:use-module (gnu packages databases) #:use-module (gnu packages emacs) #:use-module (gnu packages gcc) #:use-module (gnu packages graphviz) @@ -50,6 +49,7 @@ (define-module (gnu packages code) #:use-module (gnu packages perl) #:use-module (gnu packages pkg-config) #:use-module (gnu packages python) + #:use-module (gnu packages sqlite) #:use-module (gnu packages texinfo) #:use-module (gnu packages ncurses) #:use-module (gnu packages llvm) diff --git a/gnu/packages/compression.scm b/gnu/packages/compression.scm index ea3d72c011..261746f08a 100644 --- a/gnu/packages/compression.scm +++ b/gnu/packages/compression.scm @@ -47,8 +47,6 @@ (define-module (gnu packages compression) #:use-module (guix git-download) #:use-module (guix build-system cmake) #:use-module (guix build-system gnu) - #:use-module (guix build-system perl) - #:use-module (guix build-system python) #:use-module (gnu packages) #:use-module (gnu packages assembly) #:use-module (gnu packages autotools) @@ -60,7 +58,6 @@ (define-module (gnu packages compression) #:use-module (gnu packages file) #:use-module (gnu packages maths) #:use-module (gnu packages perl) - #:use-module (gnu packages perl-check) #:use-module (gnu packages pkg-config) #:use-module (gnu packages python) #:use-module (gnu packages tls) @@ -463,44 +460,6 @@ (define-public lzo format are designed to be portable across platforms.") (license license:gpl2+))) -(define-public python-lzo - (package - (name "python-lzo") - (version "1.12") - (source - (origin - (method url-fetch) - (uri (pypi-uri "python-lzo" version)) - (sha256 - (base32 - "0iakqgd51n1cd7r3lpdylm2rgbmd16y74cra9kcapwg84mlf9a4p")))) - (build-system python-build-system) - (arguments - `(#:test-target "check" - #:phases - (modify-phases %standard-phases - (add-after 'unpack 'patch-setuppy - (lambda _ - (substitute* "setup.py" - (("include_dirs.append\\(.*\\)") - (string-append "include_dirs.append('" - (assoc-ref %build-inputs "lzo") - "/include/lzo" - "')"))) - #t))))) - (inputs - `(("lzo" ,lzo))) - (home-page "https://github.com/jd-boyd/python-lzo") - (synopsis "Python bindings for the LZO data compression library") - (description - "Python-LZO provides Python bindings for LZO, i.e. you can access -the LZO library from your Python scripts thereby compressing ordinary -Python strings.") - (license license:gpl2+))) - -(define-public python2-lzo - (package-with-python2 python-lzo)) - (define-public lzop (package (name "lzop") @@ -710,84 +669,6 @@ (define-public libmspack decompression of some loosely related file formats used by Microsoft.") (license license:lgpl2.1+))) -(define-public perl-compress-raw-bzip2 - (package - (name "perl-compress-raw-bzip2") - (version "2.081") - (source - (origin - (method url-fetch) - (uri (string-append "mirror://cpan/authors/id/P/PM/PMQS/" - "Compress-Raw-Bzip2-" version ".tar.gz")) - (sha256 - (base32 - "081mpkjy688lg48997fqh3d7ja12vazmz02fw84495civg4vb4l6")))) - (build-system perl-build-system) - ;; TODO: Use our bzip2 package. - (home-page "https://metacpan.org/release/Compress-Raw-Bzip2") - (synopsis "Low-level interface to bzip2 compression library") - (description "This module provides a Perl interface to the bzip2 -compression library.") - (license license:perl-license))) - -(define-public perl-compress-raw-zlib - (package - (name "perl-compress-raw-zlib") - (version "2.081") - (source - (origin - (method url-fetch) - (uri (string-append "mirror://cpan/authors/id/P/PM/PMQS/" - "Compress-Raw-Zlib-" version ".tar.gz")) - (sha256 - (base32 - "06rsm9ahp20xfyvd3jc69sd0k8vqysryxc6apzdbn96jbcsdwmp1")))) - (build-system perl-build-system) - (inputs - `(("zlib" ,zlib))) - (arguments - `(#:phases (modify-phases %standard-phases - (add-before - 'configure 'configure-zlib - (lambda* (#:key inputs #:allow-other-keys) - (call-with-output-file "config.in" - (lambda (port) - (format port " -BUILD_ZLIB = False -INCLUDE = ~a/include -LIB = ~:*~a/lib -OLD_ZLIB = False -GZIP_OS_CODE = AUTO_DETECT" - (assoc-ref inputs "zlib")))) - #t))))) - (home-page "https://metacpan.org/release/Compress-Raw-Zlib") - (synopsis "Low-level interface to zlib compression library") - (description "This module provides a Perl interface to the zlib -compression library.") - (license license:perl-license))) - -(define-public perl-io-compress - (package - (name "perl-io-compress") - (version "2.081") - (source - (origin - (method url-fetch) - (uri (string-append "mirror://cpan/authors/id/P/PM/PMQS/" - "IO-Compress-" version ".tar.gz")) - (sha256 - (base32 - "1na66ns1g3nni0m9q5494ym4swr21hfgpv88mw8wbj2daiswf4aj")))) - (build-system perl-build-system) - (propagated-inputs - `(("perl-compress-raw-zlib" ,perl-compress-raw-zlib) ; >=2.081 - ("perl-compress-raw-bzip2" ,perl-compress-raw-bzip2))) ; >=2.081 - (home-page "https://metacpan.org/release/IO-Compress") - (synopsis "IO Interface to compressed files/buffers") - (description "IO-Compress provides a Perl interface to allow reading and -writing of compressed data created with the zlib and bzip2 libraries.") - (license license:perl-license))) - (define-public lz4 (package (name "lz4") @@ -820,54 +701,6 @@ (define-public lz4 ;; line interface programs (lz4, fullbench, fuzzer, datagen) are GPL2+. (license (list license:bsd-2 license:gpl2+)))) -(define-public python-lz4 - (package - (name "python-lz4") - (version "0.10.1") - (source - (origin - (method url-fetch) - (uri (pypi-uri "lz4" version)) - (sha256 - (base32 - "0ghv1xbaq693kgww1x9c22bplz479ls9szjsaa4ig778ls834hm0")))) - (build-system python-build-system) - (native-inputs - `(("python-nose" ,python-nose) - ("python-setuptools-scm" ,python-setuptools-scm))) - (home-page "https://github.com/python-lz4/python-lz4") - (synopsis "LZ4 bindings for Python") - (description - "This package provides python bindings for the lz4 compression library -by Yann Collet. The project contains bindings for the LZ4 block format and -the LZ4 frame format.") - (license license:bsd-3))) - -(define-public python2-lz4 - (package-with-python2 python-lz4)) - -(define-public python-lzstring - (package - (name "python-lzstring") - (version "1.0.4") - (source - (origin - (method url-fetch) - (uri (pypi-uri "lzstring" version)) - (sha256 - (base32 - "18ly9pppy2yspxzw7k1b23wk77k7m44rz2g0271bqgqrk3jn3yhs")))) - (build-system python-build-system) - (propagated-inputs - `(("python-future" ,python-future))) - (home-page "https://github.com/gkovacs/lz-string-python") - (synopsis "String compression") - (description "Lz-string is a string compressor library for Python.") - (license license:expat))) - -(define-public python2-lzstring - (package-with-python2 python-lzstring)) - (define-public squashfs-tools (package (name "squashfs-tools") @@ -1197,46 +1030,6 @@ (define-public lrzip (license (list license:gpl3+ license:public-domain)))) ; most files in lzma/ -(define-public bitshuffle - (package - (name "bitshuffle") - (version "0.3.5") - (source (origin - (method url-fetch) - (uri (pypi-uri "bitshuffle" version)) - (sha256 - (base32 - "1823x61kyax4dc2hjmc1xraskxi1193y8lvxd03vqv029jrj8cjy")) - (modules '((guix build utils))) - (snippet - '(begin - ;; Remove generated Cython files. - (delete-file "bitshuffle/h5.c") - (delete-file "bitshuffle/ext.c") - #t)))) - (build-system python-build-system) - (arguments - `(#:tests? #f ; fail: https://github.com/h5py/h5py/issues/769 - #:phases - (modify-phases %standard-phases - (add-after 'unpack 'dont-build-native - (lambda _ - (substitute* "setup.py" - (("'-march=native', ") "")) - #t))))) - (inputs - `(("numpy" ,python-numpy) - ("h5py" ,python-h5py) - ("hdf5" ,hdf5))) - (native-inputs - `(("cython" ,python-cython))) - (home-page "https://github.com/kiyo-masui/bitshuffle") - (synopsis "Filter for improving compression of typed binary data") - (description "Bitshuffle is an algorithm that rearranges typed, binary data -for improving compression, as well as a python/C package that implements this -algorithm within the Numpy framework.") - (license license:expat))) - (define-public snappy (package (name "snappy") @@ -1263,44 +1056,6 @@ (define-public snappy 100% bigger.") (license license:asl2.0))) -(define-public bitshuffle-for-snappy - (package - (inherit bitshuffle) - (name "bitshuffle-for-snappy") - (build-system gnu-build-system) - (arguments - (substitute-keyword-arguments (package-arguments bitshuffle) - ((#:tests? _ #f) #f) - ((#:phases phases) - `(modify-phases %standard-phases - (replace 'configure - (lambda* (#:key outputs #:allow-other-keys) - (with-output-to-file "Makefile" - (lambda _ - (format #t "\ -libbitshuffle.so: src/bitshuffle.o src/bitshuffle_core.o src/iochain.o lz4/lz4.o -\tgcc -O3 -ffast-math -std=c99 -o $@ -shared -fPIC $^ - -%.o: %.c -\tgcc -O3 -ffast-math -std=c99 -fPIC -Isrc -Ilz4 -c $< -o $@ - -PREFIX:=~a -LIBDIR:=$(PREFIX)/lib -INCLUDEDIR:=$(PREFIX)/include - -install: libbitshuffle.so -\tinstall -dm755 $(LIBDIR) -\tinstall -dm755 $(INCLUDEDIR) -\tinstall -m755 libbitshuffle.so $(LIBDIR) -\tinstall -m644 src/bitshuffle.h $(INCLUDEDIR) -\tinstall -m644 src/bitshuffle_core.h $(INCLUDEDIR) -\tinstall -m644 src/iochain.h $(INCLUDEDIR) -\tinstall -m644 lz4/lz4.h $(INCLUDEDIR) -" (assoc-ref outputs "out")))) - #t)))))) - (inputs '()) - (native-inputs '()))) - (define-public p7zip (package (name "p7zip") @@ -1755,29 +1510,6 @@ (define-public zziplib ;; files carry the Zlib license; see "docs/copying.html" for details. (license (list license:lgpl2.0+ license:mpl1.1)))) -(define-public perl-archive-zip - (package - (name "perl-archive-zip") - (version "1.64") - (source - (origin - (method url-fetch) - (uri (string-append - "mirror://cpan/authors/id/P/PH/PHRED/Archive-Zip-" - version ".tar.gz")) - (sha256 - (base32 - "0zfinh8nx3rxzscp57vq3w8hihpdb0zs67vvalykcf402kr88pyy")))) - (build-system perl-build-system) - (native-inputs - ;; For tests. - `(("perl-test-mockmodule" ,perl-test-mockmodule))) - (synopsis "Provides an interface to Zip archive files") - (description "The @code{Archive::Zip} module allows a Perl program to -create, manipulate, read, and write Zip archive files.") - (home-page "https://metacpan.org/release/Archive-Zip") - (license license:perl-license))) - (define-public libzip (package (name "libzip") @@ -1838,27 +1570,6 @@ (define-public atool of archives.") (license license:gpl2+))) -(define-public perl-archive-extract - (package - (name "perl-archive-extract") - (version "0.80") - (source - (origin - (method url-fetch) - (uri (string-append "mirror://cpan/authors/id/B/BI/BINGOS/Archive-Extract-" - version ".tar.gz")) - (sha256 - (base32 - "1x15j1q6w6z8hqyqgap0lz4qbq2174wfhksy1fdd653ccbaw5jr5")))) - (build-system perl-build-system) - (home-page "https://metacpan.org/release/Archive-Extract") - (synopsis "Generic archive extracting mechanism") - (description "It allows you to extract any archive file of the type .tar, -.tar.gz, .gz, .Z, tar.bz2, .tbz, .bz2, .zip, .xz,, .txz, .tar.xz or .lzma -without having to worry how it does so, or use different interfaces for each -type by using either Perl modules, or command-line tools on your system.") - (license license:perl-license))) - (define-public lunzip (package (name "lunzip") diff --git a/gnu/packages/connman.scm b/gnu/packages/connman.scm index 55dd4a632b..1dbbe7c1c2 100644 --- a/gnu/packages/connman.scm +++ b/gnu/packages/connman.scm @@ -34,6 +34,7 @@ (define-module (gnu packages connman) #:use-module (gnu packages pkg-config) #:use-module (gnu packages polkit) #:use-module (gnu packages python) + #:use-module (gnu packages python-xyz) #:use-module (gnu packages qt) #:use-module (gnu packages readline) #:use-module (gnu packages samba) diff --git a/gnu/packages/cran.scm b/gnu/packages/cran.scm index 09cb2a1d02..1bd20b12d3 100644 --- a/gnu/packages/cran.scm +++ b/gnu/packages/cran.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ricardo Wurmus +;;; Copyright © 2016, 2017 Ben Woodcroft ;;; Copyright © 2017, 2018 Roel Janssen ;;; Copyright © 2017, 2018 Tobias Geerinckx-Rice ;;; Copyright © 2017 Raoul Bonnal @@ -82,6 +83,36 @@ (define-public r-clipr the system clipboards.") (license license:gpl3))) +(define-public r-vegan + (package + (name "r-vegan") + (version "2.5-3") + (source + (origin + (method url-fetch) + (uri (cran-uri "vegan" version)) + (sha256 + (base32 + "023xznh0iy0496icpchadmp7a3rk3nj9s48fvwlvp3dssw58yp3c")))) + (build-system r-build-system) + (native-inputs + `(("gfortran" ,gfortran))) + (propagated-inputs + `(("r-cluster" ,r-cluster) + ("r-knitr" ,r-knitr) ; needed for vignettes + ("r-lattice" ,r-lattice) + ("r-mass" ,r-mass) + ("r-mgcv" ,r-mgcv) + ("r-permute" ,r-permute))) + (home-page "https://cran.r-project.org/web/packages/vegan") + (synopsis "Functions for community ecology") + (description + "The vegan package provides tools for descriptive community ecology. It +has most basic functions of diversity analysis, community ordination and +dissimilarity analysis. Most of its multivariate tools can be used for other +data types as well.") + (license license:gpl2+))) + (define-public r-tidyverse (package (name "r-tidyverse") @@ -2503,14 +2534,14 @@ (define-public r-ipred (define-public r-psych (package (name "r-psych") - (version "1.8.10") + (version "1.8.12") (source (origin (method url-fetch) (uri (cran-uri "psych" version)) (sha256 (base32 - "0n3frgzsfmnan6cp3yyq5h6c28v5pd7q5a42pp6byaa7n7d1v478")))) + "0hvp0dkkkn0szaf5rkirr3kb8qmr4bxwl775m5wmpvn1kc25w5vf")))) (build-system r-build-system) (propagated-inputs `(("r-foreign" ,r-foreign) @@ -6459,13 +6490,13 @@ (define-public r-mosaiccore (define-public r-ggformula (package (name "r-ggformula") - (version "0.9.0") + (version "0.9.1") (source (origin (method url-fetch) (uri (cran-uri "ggformula" version)) (sha256 - (base32 "1pmpdfjfbrc6kcpq70cr1kbj2qy711hw940g2aiis6l443z706kh")))) + (base32 "01ngx8qh9lhmagng6abx2ky54zi3iyj5bpxlnw59slagwv7l6icx")))) (build-system r-build-system) (propagated-inputs `(("r-ggplot2" ,r-ggplot2) @@ -6504,6 +6535,29 @@ (define-public r-mosaicdata used to teach mathematics, statistics, computation and modeling.") (license license:gpl2+))) +(define-public r-raster + (package + (name "r-raster") + (version "2.8-4") + (source + (origin + (method url-fetch) + (uri (cran-uri "raster" version)) + (sha256 + (base32 + "14pcfznxm5kdwd908axkr9v1l0hzxlrwd8kwrz0liqnfh9cx5rsa")))) + (build-system r-build-system) + (propagated-inputs + `(("r-rcpp" ,r-rcpp) + ("r-sp" ,r-sp))) + (home-page "http://www.rspatial.org/") + (synopsis "Geographic data analysis and modeling") + (description + "The package implements basic and high-level functions for reading, +writing, manipulating, analyzing and modeling of gridded spatial data. +Processing of very large files is supported.") + (license license:gpl3+))) + (define-public r-mosaic (package (name "r-mosaic") diff --git a/gnu/packages/crypto.scm b/gnu/packages/crypto.scm index 0a507aead6..2c63e53191 100644 --- a/gnu/packages/crypto.scm +++ b/gnu/packages/crypto.scm @@ -39,7 +39,6 @@ (define-module (gnu packages crypto) #:use-module (gnu packages check) #:use-module (gnu packages compression) #:use-module (gnu packages cryptsetup) - #:use-module (gnu packages databases) #:use-module (gnu packages gettext) #:use-module (gnu packages gnupg) #:use-module (gnu packages image) @@ -53,10 +52,12 @@ (define-module (gnu packages crypto) #:use-module (gnu packages perl-check) #:use-module (gnu packages pkg-config) #:use-module (gnu packages python) + #:use-module (gnu packages python-xyz) #:use-module (gnu packages readline) #:use-module (gnu packages search) #:use-module (gnu packages serialization) #:use-module (gnu packages shells) + #:use-module (gnu packages sqlite) #:use-module (gnu packages tcl) #:use-module (gnu packages tls) #:use-module (gnu packages xml) diff --git a/gnu/packages/cups.scm b/gnu/packages/cups.scm index 5eb66feed5..9c470c4bb6 100644 --- a/gnu/packages/cups.scm +++ b/gnu/packages/cups.scm @@ -40,6 +40,7 @@ (define-module (gnu packages cups) #:use-module (gnu packages pkg-config) #:use-module (gnu packages pretty-print) #:use-module (gnu packages python) + #:use-module (gnu packages python-xyz) #:use-module (gnu packages qt) #:use-module (gnu packages scanner) #:use-module (gnu packages tls) diff --git a/gnu/packages/cyrus-sasl.scm b/gnu/packages/cyrus-sasl.scm index 0a5e464719..f84136e631 100644 --- a/gnu/packages/cyrus-sasl.scm +++ b/gnu/packages/cyrus-sasl.scm @@ -20,7 +20,7 @@ (define-module (gnu packages cyrus-sasl) #:use-module (gnu packages) - #:use-module (gnu packages databases) + #:use-module (gnu packages dbm) #:use-module (gnu packages kerberos) #:use-module (gnu packages tls) #:use-module ((guix licenses) #:prefix license:) diff --git a/gnu/packages/databases.scm b/gnu/packages/databases.scm index 150369a70c..e1284ee9bd 100644 --- a/gnu/packages/databases.scm +++ b/gnu/packages/databases.scm @@ -64,6 +64,7 @@ (define-module (gnu packages databases) #:use-module (gnu packages crypto) #:use-module (gnu packages curl) #:use-module (gnu packages cyrus-sasl) + #:use-module (gnu packages dbm) #:use-module (gnu packages emacs) #:use-module (gnu packages gettext) #:use-module (gnu packages glib) @@ -85,10 +86,12 @@ (define-module (gnu packages databases) #:use-module (gnu packages popt) #:use-module (gnu packages python) #:use-module (gnu packages python-crypto) + #:use-module (gnu packages python-xyz) #:use-module (gnu packages rdf) #:use-module (gnu packages readline) #:use-module (gnu packages ruby) #:use-module (gnu packages serialization) + #:use-module (gnu packages sqlite) #:use-module (gnu packages tcl) #:use-module (gnu packages terminals) #:use-module (gnu packages textutils) @@ -159,28 +162,6 @@ (define-public 4store either single machines or networked clusters.") (license license:gpl3+))) -(define-public gdbm - (package - (name "gdbm") - (version "1.18") - (source (origin - (method url-fetch) - (uri (string-append "mirror://gnu/gdbm/gdbm-" - version ".tar.gz")) - (sha256 - (base32 - "1kimnv12bzjjhaqk4c8w2j6chdj9c6bg21lchaf7abcyfss2r0mq")))) - (arguments `(#:configure-flags '("--enable-libgdbm-compat"))) - (build-system gnu-build-system) - (home-page "http://www.gnu.org.ua/software/gdbm") - (synopsis - "Hash library of database functions compatible with traditional dbm") - (description - "GDBM is a library for manipulating hashed databases. It is used to -store key/value pairs in a file in a manner similar to the Unix dbm library -and provides interfaces to the traditional file format.") - (license license:gpl3+))) - (define-public go-gopkg.in-mgo.v2 (package (name "go-gopkg.in-mgo.v2") @@ -227,109 +208,6 @@ (define-public go-gopkg.in-mgo.v2 (home-page "http://labix.org/mgo") (license license:bsd-2))) -(define-public bdb - (package - (name "bdb") - (version "6.2.32") - (source (origin - (method url-fetch) - (uri (string-append "http://download.oracle.com/berkeley-db/db-" - version ".tar.gz")) - (sha256 - (base32 - "1yx8wzhch5wwh016nh0kfxvknjkafv6ybkqh6nh7lxx50jqf5id9")))) - (build-system gnu-build-system) - (outputs '("out" ; programs, libraries, headers - "doc")) ; 94 MiB of HTML docs - (arguments - '(#:tests? #f ; no check target available - #:disallowed-references ("doc") - #:phases - (modify-phases %standard-phases - (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"))) - - (invoke "./dist/configure" - (string-append "--prefix=" out) - (string-append "CONFIG_SHELL=" (which "bash")) - (string-append "SHELL=" (which "bash")) - - ;; Remove 7 MiB of .a files. - "--disable-static" - - ;; The compatibility mode is needed by some packages, - ;; notably iproute2. - "--enable-compat185" - - ;; The following flag is needed so that the inclusion - ;; of db_cxx.h into C++ files works; it leads to - ;; HAVE_CXX_STDHEADERS being defined in db_cxx.h. - "--enable-cxx"))))))) - (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.") - ;; Starting with version 6, BDB is distributed under AGPL3. Many individual - ;; files are covered by the 3-clause BSD license. - (license (list license:agpl3+ license:bsd-3)) - (home-page - "http://www.oracle.com/us/products/database/berkeley-db/overview/index.html"))) - -(define-public bdb-5.3 - (package (inherit bdb) - (name "bdb") - (version "5.3.28") - (license (license:non-copyleft "file://LICENSE" - "See LICENSE in the distribution.")) - (source (origin - (method url-fetch) - (uri (string-append "http://download.oracle.com/berkeley-db/db-" - version ".tar.gz")) - (sha256 - (base32 - "0a1n5hbl7027fbz5lm0vp0zzfp1hmxnz14wx3zl9563h83br5ag0")))) - (arguments - `(#:tests? #f ; no check target available - #:disallowed-references ("doc") - #:phases - (modify-phases %standard-phases - (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"))) - - (invoke "./dist/configure" - (string-append "--prefix=" out) - (string-append "CONFIG_SHELL=" (which "bash")) - (string-append "SHELL=" (which "bash")) - - ;; Bdb doesn't recognize aarch64 as an architecture. - ,@(if (string=? "aarch64-linux" (%current-system)) - '("--build=aarch64-unknown-linux-gnu") - '()) - - ;; Remove 7 MiB of .a files. - "--disable-static" - - ;; The compatibility mode is needed by some packages, - ;; notably iproute2. - "--enable-compat185" - - ;; The following flag is needed so that the inclusion - ;; of db_cxx.h into C++ files works; it leads to - ;; HAVE_CXX_STDHEADERS being defined in db_cxx.h. - "--enable-cxx"))))))))) - (define-public es-dump-restore (package (name "es-dump-restore") @@ -1144,87 +1022,6 @@ (define-public sqlcrush changes.") (license license:gpl3+)))) ; no headers, see README.md -(define-public sqlite - (package - (name "sqlite") - (replacement sqlite-3.26.0) - (version "3.24.0") - (source (origin - (method url-fetch) - (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 "https://sqlite.org/2018/sqlite-autoconf-" - numeric-version ".tar.gz"))) - (sha256 - (base32 - "0jmprv2vpggzhy7ma4ynmv1jzn3pfiwzkld0kkg6hvgvqs44xlfr")))) - (build-system gnu-build-system) - (inputs `(("readline" ,readline))) - (arguments - `(#:configure-flags - ;; Add -DSQLITE_SECURE_DELETE, -DSQLITE_ENABLE_UNLOCK_NOTIFY and - ;; -DSQLITE_ENABLE_DBSTAT_VTAB to CFLAGS. GNU Icecat will refuse - ;; to use the system SQLite unless these options are enabled. - (list (string-append "CFLAGS=-O2 -DSQLITE_SECURE_DELETE " - "-DSQLITE_ENABLE_UNLOCK_NOTIFY " - "-DSQLITE_ENABLE_DBSTAT_VTAB")))) - (home-page "https://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 license:public-domain))) - -(define-public sqlite-3.26.0 - (package (inherit sqlite) - (version "3.26.0") - (source (origin - (method url-fetch) - (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 "https://sqlite.org/2018/sqlite-autoconf-" - numeric-version ".tar.gz"))) - (sha256 - (base32 - "0pdzszb4sp73hl36siiv3p300jvfvbcdxi2rrmkwgs6inwznmajx")))))) - -;; This is used by Tracker. -(define-public sqlite-with-fts5 - (package/inherit sqlite - (name "sqlite-with-fts5") - (arguments - (substitute-keyword-arguments (package-arguments sqlite) - ((#:configure-flags flags) - `(cons "--enable-fts5" ,flags)))))) - -;; This is used by Qt. -(define-public sqlite-with-column-metadata - (package/inherit sqlite - (name "sqlite-with-column-metadata") - (arguments - (substitute-keyword-arguments (package-arguments sqlite) - ((#:configure-flags flags) - `(list (string-append "CFLAGS=-O2 -DSQLITE_SECURE_DELETE " - "-DSQLITE_ENABLE_UNLOCK_NOTIFY " - "-DSQLITE_ENABLE_DBSTAT_VTAB " - "-DSQLITE_ENABLE_COLUMN_METADATA"))))))) - (define-public tdb (package (name "tdb") diff --git a/gnu/packages/datastructures.scm b/gnu/packages/datastructures.scm index c2c2c59be4..c3e96a0b12 100644 --- a/gnu/packages/datastructures.scm +++ b/gnu/packages/datastructures.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015, 2016, 2019 Ricardo Wurmus -;;; Copyright © 2016, 2017 Tobias Geerinckx-Rice +;;; Copyright © 2016, 2017, 2019 Tobias Geerinckx-Rice ;;; Copyright © 2018 Meiyo Peng ;;; ;;; This file is part of GNU Guix. @@ -123,18 +123,18 @@ (define-public ssdeep (define-public liburcu (package (name "liburcu") - (version "0.10.1") + (version "0.10.2") (source (origin (method url-fetch) (uri (string-append "https://www.lttng.org/files/urcu/" "userspace-rcu-" version ".tar.bz2")) (sha256 (base32 - "01pbg67qy5hcssy2yi0ckqapzfclgdq93li2rmzw4pa3wh5j42cw")))) + "1k31faqz9plx5dwxq8g1fnczxda1is4s1x4ph0gjrq3gmy6qixmk")))) (build-system gnu-build-system) (native-inputs `(("perl" ,perl))) ; for tests - (home-page "http://liburcu.org/") + (home-page "https://liburcu.org/") (synopsis "User-space RCU data synchronisation library") (description "liburcu is a user-space @dfn{Read-Copy-Update} (RCU) data synchronisation library. It provides read-side access that scales linearly diff --git a/gnu/packages/dav.scm b/gnu/packages/dav.scm index e937d59358..0bb446bc3c 100644 --- a/gnu/packages/dav.scm +++ b/gnu/packages/dav.scm @@ -25,7 +25,8 @@ (define-module (gnu packages dav) #:use-module (gnu packages) #:use-module (gnu packages check) #:use-module (gnu packages python) - #:use-module (gnu packages python-web)) + #:use-module (gnu packages python-web) + #:use-module (gnu packages python-xyz)) (define-public radicale (package diff --git a/gnu/packages/dbm.scm b/gnu/packages/dbm.scm new file mode 100644 index 0000000000..bf548a25f3 --- /dev/null +++ b/gnu/packages/dbm.scm @@ -0,0 +1,159 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2012, 2013, 2014, 2016 Ludovic Courtès +;;; Copyright © 2013, 2015 Andreas Enge +;;; Copyright © 2016, 2017, 2018 Efraim Flashner +;;; Copyright © 2017, 2018 Marius Bakke +;;; Copyright © 2018 Mark H Weaver +;;; +;;; 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 . + +(define-module (gnu packages dbm) + #:use-module (gnu packages) + #:use-module ((guix licenses) #:prefix license:) + #:use-module (guix packages) + #:use-module (guix download) + #:use-module (guix build-system gnu) + #:use-module (guix utils)) + +;;; Commentary: +;;; +;;; This module has been separated from (gnu packages databases) to reduce the +;;; number of module references for core packages. + +(define-public bdb + (package + (name "bdb") + (version "6.2.32") + (source (origin + (method url-fetch) + (uri (string-append "http://download.oracle.com/berkeley-db/db-" + version ".tar.gz")) + (sha256 + (base32 + "1yx8wzhch5wwh016nh0kfxvknjkafv6ybkqh6nh7lxx50jqf5id9")))) + (build-system gnu-build-system) + (outputs '("out" ; programs, libraries, headers + "doc")) ; 94 MiB of HTML docs + (arguments + '(#:tests? #f ; no check target available + #:disallowed-references ("doc") + #:phases + (modify-phases %standard-phases + (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"))) + + (invoke "./dist/configure" + (string-append "--prefix=" out) + (string-append "CONFIG_SHELL=" (which "bash")) + (string-append "SHELL=" (which "bash")) + + ;; Remove 7 MiB of .a files. + "--disable-static" + + ;; The compatibility mode is needed by some packages, + ;; notably iproute2. + "--enable-compat185" + + ;; The following flag is needed so that the inclusion + ;; of db_cxx.h into C++ files works; it leads to + ;; HAVE_CXX_STDHEADERS being defined in db_cxx.h. + "--enable-cxx"))))))) + (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.") + ;; Starting with version 6, BDB is distributed under AGPL3. Many individual + ;; files are covered by the 3-clause BSD license. + (license (list license:agpl3+ license:bsd-3)) + (home-page + "http://www.oracle.com/us/products/database/berkeley-db/overview/index.html"))) + +(define-public bdb-5.3 + (package (inherit bdb) + (name "bdb") + (version "5.3.28") + (license (license:non-copyleft "file://LICENSE" + "See LICENSE in the distribution.")) + (source (origin + (method url-fetch) + (uri (string-append "http://download.oracle.com/berkeley-db/db-" + version ".tar.gz")) + (sha256 + (base32 + "0a1n5hbl7027fbz5lm0vp0zzfp1hmxnz14wx3zl9563h83br5ag0")))) + (arguments + `(#:tests? #f ; no check target available + #:disallowed-references ("doc") + #:phases + (modify-phases %standard-phases + (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"))) + + (invoke "./dist/configure" + (string-append "--prefix=" out) + (string-append "CONFIG_SHELL=" (which "bash")) + (string-append "SHELL=" (which "bash")) + + ;; Bdb doesn't recognize aarch64 as an architecture. + ,@(if (string=? "aarch64-linux" (%current-system)) + '("--build=aarch64-unknown-linux-gnu") + '()) + + ;; Remove 7 MiB of .a files. + "--disable-static" + + ;; The compatibility mode is needed by some packages, + ;; notably iproute2. + "--enable-compat185" + + ;; The following flag is needed so that the inclusion + ;; of db_cxx.h into C++ files works; it leads to + ;; HAVE_CXX_STDHEADERS being defined in db_cxx.h. + "--enable-cxx"))))))))) + +(define-public gdbm + (package + (name "gdbm") + (version "1.18") + (source (origin + (method url-fetch) + (uri (string-append "mirror://gnu/gdbm/gdbm-" + version ".tar.gz")) + (sha256 + (base32 + "1kimnv12bzjjhaqk4c8w2j6chdj9c6bg21lchaf7abcyfss2r0mq")))) + (arguments `(#:configure-flags '("--enable-libgdbm-compat"))) + (build-system gnu-build-system) + (home-page "http://www.gnu.org.ua/software/gdbm") + (synopsis + "Hash library of database functions compatible with traditional dbm") + (description + "GDBM is a library for manipulating hashed databases. It is used to +store key/value pairs in a file in a manner similar to the Unix dbm library +and provides interfaces to the traditional file format.") + (license license:gpl3+))) diff --git a/gnu/packages/dc.scm b/gnu/packages/dc.scm index ae019da6e8..29d5e451d2 100644 --- a/gnu/packages/dc.scm +++ b/gnu/packages/dc.scm @@ -23,7 +23,7 @@ (define-module (gnu packages dc) #:use-module (gnu packages glib) #:use-module (gnu packages ncurses) #:use-module (gnu packages pkg-config) - #:use-module (gnu packages databases) + #:use-module (gnu packages sqlite) #:use-module (gnu packages tls) #:use-module (guix packages) #:use-module (guix download) diff --git a/gnu/packages/debug.scm b/gnu/packages/debug.scm index 7cb162918a..4e63c81b64 100644 --- a/gnu/packages/debug.scm +++ b/gnu/packages/debug.scm @@ -285,7 +285,8 @@ (define-public stress-make ;; patch-* phases work properly, we unpack the source first, then ;; repack before the configure phase. (let ((make-dir (string-append "make-" (package-version gnu-make)))) - `(#:configure-flags '("--with-make-tar=./make.tar.xz") + `(#:configure-flags '("--with-make-tar=./make.tar.xz" + "make_cv_sys_gnu_glob=yes") #:phases (modify-phases %standard-phases (add-after 'unpack 'unpack-make diff --git a/gnu/packages/direct-connect.scm b/gnu/packages/direct-connect.scm index ac0a490520..b2e9776f94 100644 --- a/gnu/packages/direct-connect.scm +++ b/gnu/packages/direct-connect.scm @@ -27,7 +27,7 @@ (define-module (gnu packages direct-connect) #:use-module (gnu packages gnome) #:use-module (gnu packages gtk) #:use-module (gnu packages pkg-config) - #:use-module (gnu packages python) + #:use-module (gnu packages python-xyz) #:use-module (gnu packages tls) #:use-module (gnu packages version-control)) diff --git a/gnu/packages/disk.scm b/gnu/packages/disk.scm index 33dba016ca..ceacd98a43 100644 --- a/gnu/packages/disk.scm +++ b/gnu/packages/disk.scm @@ -38,7 +38,6 @@ (define-module (gnu packages disk) #:use-module (gnu packages check) #:use-module (gnu packages compression) #:use-module (gnu packages cryptsetup) - #:use-module (gnu packages databases) #:use-module (gnu packages docbook) #:use-module (gnu packages documentation) #:use-module (gnu packages elf) @@ -55,7 +54,9 @@ (define-module (gnu packages disk) #:use-module (gnu packages pkg-config) #:use-module (gnu packages popt) #:use-module (gnu packages python) + #:use-module (gnu packages python-xyz) #:use-module (gnu packages readline) + #:use-module (gnu packages sqlite) #:use-module (gnu packages swig) #:use-module (gnu packages vim) #:use-module (gnu packages w3m) diff --git a/gnu/packages/django.scm b/gnu/packages/django.scm index 63570bfd48..848b1c63cb 100644 --- a/gnu/packages/django.scm +++ b/gnu/packages/django.scm @@ -32,6 +32,7 @@ (define-module (gnu packages django) #:use-module (gnu packages check) #:use-module (gnu packages python) #:use-module (gnu packages python-web) + #:use-module (gnu packages python-xyz) #:use-module (gnu packages time)) (define-public python-django @@ -196,7 +197,7 @@ (define-public python-django-filter (modify-phases %standard-phases (replace 'check (lambda _ - (zero? (system* "python" "runtests.py"))))))) + (invoke "python" "runtests.py")))))) (native-inputs `(("python-django" ,python-django) ("python-djangorestframework" ,python-djangorestframework) diff --git a/gnu/packages/dlang.scm b/gnu/packages/dlang.scm index 76988b2dbf..c03c24d9e2 100644 --- a/gnu/packages/dlang.scm +++ b/gnu/packages/dlang.scm @@ -36,6 +36,7 @@ (define-module (gnu packages dlang) #:use-module (gnu packages libedit) #:use-module (gnu packages llvm) #:use-module (gnu packages python) + #:use-module (gnu packages python-xyz) #:use-module (gnu packages textutils)) (define-public rdmd diff --git a/gnu/packages/docker.scm b/gnu/packages/docker.scm index 23695a0c06..fef4a180f3 100644 --- a/gnu/packages/docker.scm +++ b/gnu/packages/docker.scm @@ -37,6 +37,7 @@ (define-module (gnu packages docker) #:use-module (gnu packages pkg-config) #:use-module (gnu packages python) #:use-module (gnu packages python-web) + #:use-module (gnu packages python-xyz) #:use-module (gnu packages version-control) #:use-module (gnu packages virtualization)) @@ -517,7 +518,6 @@ (define-public docker-cli (let* ((out (assoc-ref outputs "out")) (out-bin (string-append out "/bin"))) (chdir "build") - (install-file (readlink "docker") out-bin) (install-file "docker" out-bin) #t)))))) (native-inputs diff --git a/gnu/packages/ebook.scm b/gnu/packages/ebook.scm index c3805a7880..21c2b2b6f0 100644 --- a/gnu/packages/ebook.scm +++ b/gnu/packages/ebook.scm @@ -47,8 +47,10 @@ (define-module (gnu packages ebook) #:use-module (gnu packages pkg-config) #:use-module (gnu packages python) #:use-module (gnu packages python-web) + #:use-module (gnu packages python-xyz) #:use-module (gnu packages qt) #:use-module (gnu packages serialization) + #:use-module (gnu packages sqlite) #:use-module (gnu packages time) #:use-module (gnu packages tls) #:use-module (gnu packages web) diff --git a/gnu/packages/education.scm b/gnu/packages/education.scm index ef97d58a84..5b899f4e78 100644 --- a/gnu/packages/education.scm +++ b/gnu/packages/education.scm @@ -27,7 +27,6 @@ (define-module (gnu packages education) #:use-module (gnu packages base) #:use-module (gnu packages bash) #:use-module (gnu packages compression) - #:use-module (gnu packages databases) #:use-module (gnu packages freedesktop) #:use-module (gnu packages gettext) #:use-module (gnu packages glib) @@ -40,6 +39,7 @@ (define-module (gnu packages education) #:use-module (gnu packages python) #:use-module (gnu packages qt) #:use-module (gnu packages sdl) + #:use-module (gnu packages sqlite) #:use-module (gnu packages texinfo) #:use-module (gnu packages xorg) #:use-module (gnu packages xml) diff --git a/gnu/packages/elf.scm b/gnu/packages/elf.scm index 2ad868ddc7..ace31ec663 100644 --- a/gnu/packages/elf.scm +++ b/gnu/packages/elf.scm @@ -34,6 +34,7 @@ (define-module (gnu packages elf) #:use-module (gnu packages m4) #:use-module (gnu packages pkg-config) #:use-module (gnu packages python) + #:use-module (gnu packages python-xyz) #:use-module (gnu packages texinfo) #:use-module (gnu packages xml)) diff --git a/gnu/packages/emacs-xyz.scm b/gnu/packages/emacs-xyz.scm new file mode 100644 index 0000000000..e90c3b3e29 --- /dev/null +++ b/gnu/packages/emacs-xyz.scm @@ -0,0 +1,12869 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 Taylan Ulrich Bayirli/Kammer +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès +;;; Copyright © 2014, 2015, 2016, 2017, 2018 Mark H Weaver +;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Alex Kost +;;; Copyright © 2015 Federico Beffa +;;; Copyright © 2015, 2016, 2017, 2018 Ricardo Wurmus +;;; Copyright © 2016, 2017, 2018 Chris Marusich +;;; Copyright © 2015, 2016, 2018 Christopher Lemmer Webber +;;; Copyright © 2016 Adriano Peluso +;;; Copyright © 2016, 2017, 2018, 2019 Efraim Flashner +;;; Copyright © 2016 David Thompson +;;; Copyright © 2016 Matthew Jordan +;;; Copyright © 2016, 2017 Roel Janssen +;;; Copyright © 2016, 2017 Nils Gillmann +;;; Copyright © 2016 Alex Griffin +;;; Copyright © 2016, 2017, 2018, 2019 Nicolas Goaziou +;;; Copyright © 2016, 2017, 2018 Alex Vong +;;; Copyright © 2016, 2017, 2018 Arun Isaac +;;; Copyright © 2017 Christopher Baines +;;; Copyright © 2017, 2018 Mathieu Othacehe +;;; Copyright © 2017, 2018, 2019 Clément Lassieur +;;; Copyright © 2017 Vasile Dumitrascu +;;; Copyright © 2017, 2018 Kyle Meyer +;;; Copyright © 2017 Kei Kebreau +;;; Copyright © 2017 George Clemmer +;;; Copyright © 2017, 2018 Feng Shu +;;; Copyright © 2017 Jan Nieuwenhuizen +;;; Copyright © 2017, 2018 Oleg Pykhalov +;;; Copyright © 2017 Mekeor Melire +;;; Copyright © 2017 Peter Mikkelsen +;;; Copyright © 2017, 2018 Tobias Geerinckx-Rice +;;; Copyright © 2017 Mike Gerwitz +;;; Copyright © 2017, 2018 Maxim Cournoyer +;;; Copyright © 2018 Sohom Bhattacharjee +;;; Copyright © 2018 Mathieu Lirzin +;;; Copyright © 2018, 2019 Pierre Neidhardt +;;; Copyright © 2018, 2019 Tim Gesthuizen +;;; Copyright © 2018 Jack Hill +;;; Copyright © 2018 Pierre-Antoine Rouby +;;; Copyright © 2018 Alex Branham +;;; Copyright © 2018 Thorsten Wilms +;;; Copyright © 2018 Pierre Langlois +;;; +;;; 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 . + +(define-module (gnu packages emacs-xyz) + #:use-module ((guix licenses) #:prefix license:) + #:use-module (guix packages) + #:use-module (guix cvs-download) + #:use-module (guix download) + #:use-module (guix git-download) + #:use-module (guix build-system gnu) + #:use-module (guix build-system cmake) + #:use-module (guix build-system emacs) + #:use-module (guix build-system glib-or-gtk) + #:use-module (guix build-system perl) + #:use-module (guix build-system trivial) + #:use-module (gnu packages) + #:use-module (gnu packages admin) + #:use-module (gnu packages audio) + #:use-module (gnu packages bash) + #:use-module (gnu packages cmake) + #:use-module (gnu packages code) + #:use-module (gnu packages databases) + #:use-module (gnu packages emacs) + #:use-module (gnu packages guile) + #:use-module (gnu packages gtk) + #:use-module (gnu packages gnome) + #:use-module (gnu packages ncurses) + #:use-module (gnu packages python) + #:use-module (gnu packages python-xyz) + #:use-module (gnu packages tex) + #:use-module (gnu packages texinfo) + #:use-module (gnu packages tcl) + #:use-module (gnu packages tls) + #:use-module (gnu packages pkg-config) + #:use-module (gnu packages xorg) + #:use-module (gnu packages lesstif) + #:use-module (gnu packages llvm) + #:use-module (gnu packages image) + #:use-module (gnu packages linux) + #:use-module (gnu packages libevent) + #: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 base) + #:use-module (gnu packages compression) + #:use-module (gnu packages xml) + #:use-module (gnu packages glib) + #:use-module (gnu packages acl) + #:use-module (gnu packages mail) + #:use-module (gnu packages package-management) + #:use-module (gnu packages perl) + #:use-module (gnu packages pdf) + #:use-module (gnu packages scheme) + #:use-module (gnu packages xiph) + #:use-module (gnu packages mp3) + #:use-module (gnu packages gettext) + #:use-module (gnu packages fribidi) + #:use-module (gnu packages gd) + #:use-module (gnu packages fontutils) + #:use-module (gnu packages password-utils) + #:use-module (gnu packages pulseaudio) + #:use-module (gnu packages xdisorg) + #:use-module (gnu packages shells) + #:use-module (gnu packages sqlite) + #:use-module (gnu packages gnupg) + #:use-module (gnu packages video) + #:use-module (gnu packages haskell) + #:use-module (gnu packages wordnet) + #:use-module (guix utils) + #:use-module (srfi srfi-1) + #:use-module (ice-9 match)) + +;;; +;;; Emacs hacking. +;;; + +(define-public emacs-geiser + (package + (name "emacs-geiser") + (version "0.10") + (source (origin + (method url-fetch) + (uri (string-append "mirror://savannah/geiser/" version + "/geiser-" version ".tar.gz")) + (sha256 + (base32 + "0pj3l7p8d60c9b4vfprnv6g5l61d74pls4b5dvd84cn4ky9mzwjv")))) + (build-system gnu-build-system) + (arguments + '(#:phases + (modify-phases %standard-phases + (add-after 'install 'post-install + (lambda* (#:key outputs #:allow-other-keys) + (symlink "geiser-install.el" + (string-append (assoc-ref outputs "out") + "/share/emacs/site-lisp/" + "geiser-autoloads.el")) + #t))))) + (inputs `(("guile" ,guile-2.2))) + (native-inputs `(("emacs" ,emacs-minimal))) + (home-page "https://nongnu.org/geiser/") + (synopsis "Collection of Emacs modes for Guile and Racket hacking") + (description + "Geiser is a collection of Emacs major and minor modes that conspire with +one or more Scheme implementations to keep the Lisp Machine Spirit alive. The +continuously running Scheme interpreter takes the center of the stage in +Geiser. A bundle of Elisp shims orchestrates the dialog between the Scheme +implementation, Emacs and, ultimately, the schemer, giving them access to live +metadata.") + (license license:bsd-3))) + +(define-public geiser + (deprecated-package "geiser" emacs-geiser)) + +(define-public emacs-paredit + (package + (name "emacs-paredit") + (version "24") + (source (origin + (method url-fetch) + (uri (string-append "http://mumble.net/~campbell/emacs/paredit-" + version ".el")) + (sha256 + (base32 + "0pp3n8q6kc70blqsaw0zlzp6bc327dpgdrjr0cnh7hqg1lras7ka")))) + (build-system emacs-build-system) + (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 license:gpl3+))) + +(define-public paredit + (deprecated-package "paredit" emacs-paredit)) + +(define-public git-modes + (package + (name "emacs-git-modes") + (version "1.2.8") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/magit/git-modes/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0h49f68yn0q4lg054adqii4qja1z2pzybm7nf4kvpq7fzjrzgv1q")))) + (build-system emacs-build-system) + (home-page "https://github.com/magit/git-modes") + (synopsis "Emacs major modes for Git configuration files") + (description + "This package provides Emacs major modes for editing various Git +configuration files, such as .gitattributes, .gitignore, and .git/config.") + (license license:gpl3+))) + +(define-public git-modes/old-name + (deprecated-package "git-modes" git-modes)) + +(define-public emacs-with-editor + (package + (name "emacs-with-editor") + (version "2.8.0") + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/magit/with-editor.git") + (commit (string-append "v" version)))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "1bbzvxnjpxqyvi808isld025b3pcidn4r2xf8hnk9bmzcfdvdr6q")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-dash" ,emacs-dash))) + (home-page "https://github.com/magit/with-editor") + (synopsis "Emacs library for using Emacsclient as EDITOR") + (description + "This package provides an Emacs library to use the Emacsclient as +@code{$EDITOR} of child processes, making sure they know how to call home. +For remote processes a substitute is provided, which communicates with Emacs +on stdout instead of using a socket as the Emacsclient does.") + (license license:gpl3+))) + +(define-public emacs-magit + (package + (name "emacs-magit") + (version "2.13.0") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/magit/magit/releases/download/" + version "/magit-" version ".tar.gz")) + (sha256 + (base32 + "1ygaah3dd3nxpyd17297xgvdcgr7pgzzwlmpnmchki0kiwgg3sbc")))) + (build-system gnu-build-system) + (native-inputs `(("texinfo" ,texinfo) + ("emacs" ,emacs-minimal))) + (inputs + `(("git" ,git) + ("perl" ,perl))) + (propagated-inputs + `(("dash" ,emacs-dash) + ("ghub" ,emacs-ghub) + ("magit-popup" ,emacs-magit-popup) + ("with-editor" ,emacs-with-editor))) + (arguments + `(#:test-target "test" + #:tests? #f ; tests are not included in the release + + #:make-flags + (list (string-append "PREFIX=" %output) + ;; Don't put .el files in a sub-directory. + (string-append "lispdir=" %output "/share/emacs/site-lisp") + (string-append "DASH_DIR=" + (assoc-ref %build-inputs "dash") + "/share/emacs/site-lisp/guix.d/dash-" + ,(package-version emacs-dash)) + (string-append "GHUB_DIR=" + (assoc-ref %build-inputs "ghub") + "/share/emacs/site-lisp/guix.d/ghub-" + ,(package-version emacs-ghub)) + (string-append "MAGIT_POPUP_DIR=" + (assoc-ref %build-inputs "magit-popup") + "/share/emacs/site-lisp/guix.d/magit-popup-" + ,(package-version emacs-magit-popup)) + (string-append "WITH_EDITOR_DIR=" + (assoc-ref %build-inputs "with-editor") + "/share/emacs/site-lisp/guix.d/with-editor-" + ,(package-version emacs-with-editor))) + + #:phases + (modify-phases %standard-phases + (delete 'configure) + (add-before + 'build 'patch-exec-paths + (lambda* (#:key inputs #:allow-other-keys) + (let ((perl (assoc-ref inputs "perl"))) + (substitute* "lisp/magit-sequence.el" + (("perl") (string-append perl "/bin/perl"))) + #t)))))) + (home-page "https://magit.vc/") + (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 license:gpl3+))) + +(define-public magit + (deprecated-package "magit" emacs-magit)) + +(define-public emacs-magit-svn + (package + (name "emacs-magit-svn") + (version "2.2.0") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/magit/magit-svn/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1c3n377v436zaxamlsz04y1ahdhp96x1vd43zaryv4y10m02ba47")))) + (build-system trivial-build-system) + (native-inputs `(("emacs" ,emacs-minimal) + ("tar" ,tar) + ("gzip" ,gzip))) + (propagated-inputs `(("dash" ,emacs-dash) + ("with-editor" ,emacs-with-editor) + ("magit" ,emacs-magit))) + (arguments + `(#:modules ((guix build utils) + (guix build emacs-utils)) + + #:builder + (begin + (use-modules (guix build utils) + (guix build emacs-utils)) + + (let* ((tar (string-append (assoc-ref %build-inputs "tar") + "/bin/tar")) + (PATH (string-append (assoc-ref %build-inputs "gzip") + "/bin")) + (emacs (string-append (assoc-ref %build-inputs "emacs") + "/bin/emacs")) + (magit (string-append (assoc-ref %build-inputs "magit") + "/share/emacs/site-lisp")) + (dash (string-append (assoc-ref %build-inputs "dash") + "/share/emacs/site-lisp/guix.d/dash-" + ,(package-version emacs-dash))) + (with-editor (string-append (assoc-ref %build-inputs "with-editor") + "/share/emacs/site-lisp/guix.d/with-editor-" + ,(package-version emacs-with-editor))) + (source (assoc-ref %build-inputs "source")) + (lisp-dir (string-append %output "/share/emacs/site-lisp"))) + (setenv "PATH" PATH) + (invoke tar "xvf" source) + + (install-file (string-append "magit-svn-" ,version "/magit-svn.el") + lisp-dir) + + (with-directory-excursion lisp-dir + (parameterize ((%emacs emacs)) + (emacs-generate-autoloads ,name lisp-dir) + (setenv "EMACSLOADPATH" + (string-append ":" magit ":" dash ":" with-editor)) + (emacs-batch-eval '(byte-compile-file "magit-svn.el")))) + #t)))) + (home-page "https://github.com/magit/magit-svn") + (synopsis "Git-SVN extension to Magit") + (description + "This package is an extension to Magit, the Git Emacs mode, providing +support for Git-SVN.") + (license license:gpl3+))) + +(define-public magit-svn + (deprecated-package "magit-svn" emacs-magit-svn)) + +(define-public emacs-magit-popup + (package + (name "emacs-magit-popup") + (version "2.12.5") + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/magit/magit-popup.git") + (commit (string-append "v" version)))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "13riknyqr6vxqll80sfhvz165flvdz367rbd0pr5slb01bnfsi2i")))) + (build-system emacs-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-before 'install 'make-info + (lambda _ + (invoke "make" "info")))))) + (native-inputs + `(("texinfo" ,texinfo))) + (propagated-inputs + `(("emacs-dash" ,emacs-dash))) + (home-page "https://github.com/magit/magit-popup") + (synopsis "Define prefix-infix-suffix command combos") + (description + "This library implements a generic interface for toggling switches and +setting options and then invoking an Emacs command which does something with +these arguments. The prototypical use is for the command to call an external +process, passing on the arguments as command line arguments.") + (license license:gpl3+))) + +(define-public emacs-treepy + (package + (name "emacs-treepy") + (version "0.1.1") + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/volrath/treepy.el.git") + (commit version))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "04zwm6gx9pxfvgfkizx6pvb1ql8pqxjyzqp8flz0432x0gq5nlxk")))) + (build-system emacs-build-system) + (home-page + "https://github.com/volrath/treepy.el") + (synopsis "Tree traversal tools") + (description + "Generic tools for recursive and iterative tree traversal based on +clojure.walk and clojure.zip respectively.") + (license license:gpl3+))) + +(define-public emacs-graphql + (package + (name "emacs-graphql") + (version "0.1.1") + (source (origin + (modules '((guix build utils))) + ;; Remove examples file with references to external packages as + ;; they do not exist at compilation time. + (snippet + '(begin (delete-file "examples.el") + #t)) + (method git-fetch) + (uri (git-reference + (url "https://github.com/vermiculus/graphql.el.git") + (commit version))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "0sp0skc1rnhi39szfbq1i99pdgd3bhn4c15cff05iqhjy2d4hniw")))) + (build-system emacs-build-system) + (home-page + "https://github.com/vermiculus/graphql.el") + (synopsis "GraphQL utilities") + (description + "GraphQL.el provides a generally-applicable domain-specific language for +creating and executing GraphQL queries against your favorite web services. +GraphQL is a data query language and runtime designed and used to request and +deliver data to mobile and web apps.") + (license license:gpl3+))) + +(define-public emacs-ghub + (package + (name "emacs-ghub") + (version "2.0.1") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/magit/ghub/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0d0qj5r1bm2aidi61rigrdaycxnyb7y1ivb3h8rpvvapsf8sk7z0")))) + (build-system emacs-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-before 'install 'make-info + (lambda _ + (invoke "make" "info")))))) + (native-inputs + `(("texinfo" ,texinfo))) + (home-page "https://github.com/magit/ghub") + (synopsis "Emacs client library for Github API and Gitlab API") + (description + "This package provides 2 files: @file{ghub.el} and @file{glab.el}, +which are the libraries that provide basic support for using the Github and +Gitlab APIs from Emacs packages. It abstracts access to API resources using +only a handful of functions that are not resource-specific.") + (license license:gpl3+))) + +(define-public emacs-scribble-mode + (let ((commit "34e9e5edb921813b6483e0fefa848efb6ee4b314") + (version "0.0") + (revision 0)) + (package + (name "emacs-scribble-mode") + (version (if (zero? revision) + version + (string-append version "-" + (number->string revision) + "." (string-take commit 7)))) + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/emacs-pe/scribble-mode.git") + (commit commit))) + (sha256 + (base32 + "0598byqpz2q6yi2q4dwd77jj9z3n99z34d3an51s9m2za0nh1qvp")))) + (build-system emacs-build-system) + (home-page "https://github.com/emacs-pe/scribble-mode") + (synopsis "Emacs mode for editing the Scribble documentation syntax.") + (description + "This package provides basic syntax highlighting and editing support +for editing Racket's Scribble documentation syntax in Emacs.") + (license license:gpl3+)))) + +(define-public emacs-haskell-mode + (package + (name "emacs-haskell-mode") + (version "16.1") + (source (origin + (method url-fetch) + (file-name (string-append name "-" version ".tar.gz")) + (uri (string-append + "https://github.com/haskell/haskell-mode/archive/v" + version ".tar.gz")) + (sha256 + (base32 "0g6lcjw7lcgavv3yrd8xjcyqgfyjl787y32r1z14amw2f009m78h")) + (patches + (search-patches ; backport test failure fixes + "haskell-mode-unused-variables.patch" + "haskell-mode-make-check.patch")))) + (inputs + `(("emacs-el-search" ,emacs-el-search) ; for tests + ("emacs-stream" ,emacs-stream))) ; for tests + (propagated-inputs + `(("emacs-dash" ,emacs-dash))) + (native-inputs + `(("emacs" ,emacs-minimal) + ("texinfo" ,texinfo))) + (build-system gnu-build-system) + (arguments + `(#:make-flags (list (string-append "EMACS=" + (assoc-ref %build-inputs "emacs") + "/bin/emacs")) + #:modules ((ice-9 match) + (srfi srfi-26) + ,@%gnu-build-system-modules) + #:phases + (modify-phases %standard-phases + (delete 'configure) + (add-before + 'build 'pre-build + (lambda* (#:key inputs #:allow-other-keys) + (define (el-dir store-dir) + (match (find-files store-dir "\\.el$") + ((f1 f2 ...) (dirname f1)) + (_ ""))) + + (let ((sh (string-append (assoc-ref inputs "bash") "/bin/sh"))) + (define emacs-prefix? (cut string-prefix? "emacs-" <>)) + + (setenv "SHELL" "sh") + (setenv "EMACSLOADPATH" + (string-concatenate + (map (match-lambda + (((? emacs-prefix? name) . dir) + (string-append (el-dir dir) ":")) + (_ "")) + inputs))) + (substitute* (find-files "." "\\.el") (("/bin/sh") sh)) + ;; embed filename to fix test failure + (let ((file "tests/haskell-cabal-tests.el")) + (substitute* file + (("\\(buffer-file-name\\)") + (format #f "(or (buffer-file-name) ~s)" file)))) + #t))) + (replace + 'install + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (el-dir (string-append out "/share/emacs/site-lisp")) + (doc (string-append + out "/share/doc/haskell-mode-" ,version)) + (info (string-append out "/share/info"))) + (define (copy-to-dir dir files) + (for-each (lambda (f) + (install-file f dir)) + files)) + + (with-directory-excursion "doc" + (invoke "makeinfo" "haskell-mode.texi") + (install-file "haskell-mode.info" info)) + (copy-to-dir doc '("CONTRIBUTING.md" "NEWS" "README.md")) + (copy-to-dir el-dir (find-files "." "\\.elc?")) + ;; These are part of other packages. + (with-directory-excursion el-dir + (for-each delete-file '("dash.el" "ert.el"))) + #t)))))) + (home-page "https://github.com/haskell/haskell-mode") + (synopsis "Haskell mode for Emacs") + (description + "This is an Emacs mode for editing, debugging and developing Haskell +programs.") + (license license:gpl3+))) + +(define-public haskell-mode + (deprecated-package "haskell-mode" emacs-haskell-mode)) + +(define-public emacs-flycheck + (package + (name "emacs-flycheck") + (version "31") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/flycheck/flycheck/releases/download/" + version "/flycheck-" version ".tar")) + (sha256 + (base32 + "01rnwan16m7cyyrfca3c5c60mbj2r3knkpzbhji2fczsf0wns240")) + (modules '((guix build utils))) + (snippet `(begin + ;; Change 'flycheck-version' so that it does not + ;; attempt to get its version from pkg-info.el. + (substitute* "flycheck.el" + (("\\(pkg-info-version-info 'flycheck\\)") + (string-append "\"" ,version "\""))) + #t)))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-dash" ,emacs-dash))) + (home-page "https://www.flycheck.org") + (synopsis "On-the-fly syntax checking") + (description + "This package provides on-the-fly syntax checking for GNU Emacs. It is a +replacement for the older Flymake extension which is part of GNU Emacs, with +many improvements and additional features. + +Flycheck provides fully-automatic, fail-safe, on-the-fly background syntax +checking for over 30 programming and markup languages with more than 70 +different tools. It highlights errors and warnings inline in the buffer, and +provides an optional IDE-like error list.") + (license license:gpl3+))) ;+GFDLv1.3+ for the manual + +(define-public emacs-a + (package + (name "emacs-a") + (version "0.1.1") + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/plexus/a.el.git") + (commit (string-append "v" version)))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "00v9w6qg3bkwdhypq0ssf0phdh0f4bcq59c20lngd6vhk0204dqi")))) + (build-system emacs-build-system) + (home-page "https://github.com/plexus/a.el/") + (synopsis + "Emacs library for dealing with association lists and hash tables") + (description "@code{emacs-a} provides Emacs Lisp functions for dealing +with associative structures in a uniform and functional way. These functions +can take association lists, hash tables, and in some cases vectors (where the +index is considered the key).") + (license license:gpl3+))) + +(define-public emacs-anaphora + (package + (name "emacs-anaphora") + (version "1.0.4") + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/rolandwalker/anaphora.git") + (commit (string-append "v" version)))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "11fgiy029sqz7nvdm7dcal95lacryz9zql0x5h05z48nrrcl4bib")))) + (build-system emacs-build-system) + (home-page "https://github.com/rolandwalker/anaphora/") + (synopsis "Anaphoric expressions for Emacs Lisp") + (description "@code{emacs-anaphora} implements anaphoric expressions for +Emacs Lisp. + +Anaphoric expressions implicitly create one or more temporary variables which +can be referred to during the expression. This technique can improve clarity +in certain cases. It also enables recursion for anonymous functions.") + (license license:public-domain))) + + +;;; +;;; Web browsing. +;;; + +(define-public emacs-w3m + ;; Emacs-w3m follows a "rolling release" model. + (package + (name "emacs-w3m") + (version "2018-11-11") + (source (origin + (method cvs-fetch) + (uri (cvs-reference + (root-directory + ":pserver:anonymous@cvs.namazu.org:/storage/cvsroot") + (module "emacs-w3m") + (revision version))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "0nvahdbjs12zg7zsk4gql02mvnv56cf1rwj2f5p42lwp3xvswiwp")))) + (build-system gnu-build-system) + (native-inputs `(("autoconf" ,autoconf) + ("texinfo" ,texinfo) + ("emacs" ,emacs-minimal))) + (inputs `(("w3m" ,w3m) + ("imagemagick" ,imagemagick))) + (arguments + `(#:modules ((guix build gnu-build-system) + (guix build utils) + (guix build emacs-utils)) + #:imported-modules (,@%gnu-build-system-modules + (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") + ;; Leave .el files uncompressed, otherwise GC can't + ;; identify run-time dependencies. See + ;; + "--without-compress-install")) + #:tests? #f ; no check target + #:phases + (modify-phases %standard-phases + (add-after 'unpack 'autoconf + (lambda _ + (invoke "autoconf"))) + (add-before 'configure 'support-emacs! + (lambda _ + ;; For some reason 'AC_PATH_EMACS' thinks that 'Emacs 26' is + ;; unsupported. + (substitute* "configure" + (("EMACS_FLAVOR=unsupported") + "EMACS_FLAVOR=emacs")) + #t)) + (add-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"))) + (make-file-writable "w3m.el") + (emacs-substitute-variables "w3m.el" + ("w3m-command" (string-append w3m "/bin/w3m")) + ("w3m-touch-command" + (string-append coreutils "/bin/touch")) + ("w3m-icon-directory" + (string-append out "/share/images/emacs-w3m"))) + (make-file-writable "w3m-image.el") + (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))) + (replace 'install + (lambda* (#:key outputs #:allow-other-keys) + (invoke "make" "install" "install-icons") + (with-directory-excursion + (string-append (assoc-ref outputs "out") + "/share/emacs/site-lisp") + (for-each delete-file '("ChangeLog" "ChangeLog.1")) + (symlink "w3m-load.el" "w3m-autoloads.el") + #t)))))) + (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 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))) + (native-inputs `(("emacs" ,emacs-minimal))) + (arguments + `(#:modules ((guix build gnu-build-system) + (guix build utils) + (guix build emacs-utils)) + #:imported-modules (,@%gnu-build-system-modules + (guix build emacs-utils)) + #:tests? #f ; no check target + #:phases + (modify-phases %standard-phases + (replace 'configure + (lambda* (#:key outputs #:allow-other-keys) + (substitute* "Makefile" + (("/usr/local") (assoc-ref outputs "out")) + (("/site-lisp/emacs-wget") "/site-lisp")) + #t)) + (add-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")))) + #t)) + (add-after 'install 'post-install + (lambda* (#:key outputs #:allow-other-keys) + (emacs-generate-autoloads + "wget" (string-append (assoc-ref outputs "out") + "/share/emacs/site-lisp/")) + #t))))) + (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 license:gpl2+))) + + +;;; +;;; Multimedia. +;;; + +(define-public emacs-emms + (package + (name "emacs-emms") + (version "5.1") + (source (origin + (method url-fetch) + (uri (string-append "mirror://gnu/emms/emms-" + version ".tar.gz")) + (sha256 + (base32 + "149ddczyx6x10zn4mn8g0rll1rwf4yciv8x6j0qdnlbwszblx2x6")) + (modules '((guix build utils))) + (snippet + '(begin + (substitute* "Makefile" + (("/usr/bin/install-info") + ;; No need to use 'install-info' since it would create a + ;; useless 'dir' file. + "true") + (("^INFODIR=.*") + ;; Install Info files to $out/share/info, not $out/info. + "INFODIR := $(PREFIX)/share/info\n") + (("/site-lisp/emms") + ;; Install directly in share/emacs/site-lisp, not in a + ;; sub-directory. + "/site-lisp") + (("^all: (.*)\n" _ rest) + ;; Build 'emms-print-metadata'. + (string-append "all: " rest " emms-print-metadata\n"))) + #t)))) + (build-system gnu-build-system) + (arguments + `(#:modules ((guix build gnu-build-system) + (guix build utils) + (guix build emacs-utils) + (ice-9 ftw)) + #:imported-modules (,@%gnu-build-system-modules + (guix build emacs-utils)) + + #:phases + (modify-phases %standard-phases + (replace 'configure + (lambda* (#:key inputs outputs #:allow-other-keys) + (let ((out (assoc-ref outputs "out")) + (flac (assoc-ref inputs "flac")) + (vorbis (assoc-ref inputs "vorbis-tools")) + (alsa (assoc-ref inputs "alsa-utils")) + (mpg321 (assoc-ref inputs "mpg321")) + (mp3info (assoc-ref inputs "mp3info")) + (opus (assoc-ref inputs "opus-tools"))) + ;; Specify the installation directory. + (substitute* "Makefile" + (("PREFIX=.*$") + (string-append "PREFIX := " out "\n"))) + + (setenv "SHELL" (which "sh")) + (setenv "CC" "gcc") + + ;; Specify the absolute file names of the various + ;; programs so that everything works out-of-the-box. + (with-directory-excursion "lisp" + (emacs-substitute-variables + "emms-player-mpg321-remote.el" + ("emms-player-mpg321-remote-command" + (string-append mpg321 "/bin/mpg321"))) + (substitute* "emms-player-simple.el" + (("\"ogg123\"") + (string-append "\"" vorbis "/bin/ogg123\""))) + (substitute* "emms-player-simple.el" + (("\"mpg321\"") + (string-append "\"" mpg321 "/bin/mpg321\""))) + (emacs-substitute-variables "emms-info-ogginfo.el" + ("emms-info-ogginfo-program-name" + (string-append vorbis "/bin/ogginfo"))) + (emacs-substitute-variables "emms-info-opusinfo.el" + ("emms-info-opusinfo-program-name" + (string-append opus "/bin/opusinfo"))) + (emacs-substitute-variables "emms-info-libtag.el" + ("emms-info-libtag-program-name" + (string-append out "/bin/emms-print-metadata"))) + (emacs-substitute-variables "emms-info-mp3info.el" + ("emms-info-mp3info-program-name" + (string-append mp3info "/bin/mp3info"))) + (emacs-substitute-variables "emms-info-metaflac.el" + ("emms-info-metaflac-program-name" + (string-append flac "/bin/metaflac"))) + (emacs-substitute-variables "emms-source-file.el" + ("emms-source-file-gnu-find" (which "find"))) + (substitute* "emms-volume-amixer.el" + (("\"amixer\"") + (string-append "\"" alsa "/bin/amixer\""))) + (substitute* "emms-tag-editor.el" + (("\"mp3info\"") + (string-append "\"" mp3info "/bin/mp3info\""))))))) + (add-before 'install 'pre-install + (lambda* (#:key outputs #:allow-other-keys) + ;; The 'install' rule expects the target directories to exist. + (let* ((out (assoc-ref outputs "out")) + (bin (string-append out "/bin")) + (man1 (string-append out "/share/man/man1"))) + (mkdir-p bin) + (mkdir-p man1) + + ;; Ensure that files are not rejected by gzip + (let ((early-1980 315619200)) ; 1980-01-02 UTC + (ftw "." (lambda (file stat flag) + (unless (<= early-1980 (stat:mtime stat)) + (utime file early-1980 early-1980)) + #t))) + #t))) + (add-after 'install 'post-install + (lambda* (#:key outputs #:allow-other-keys) + (let ((out (assoc-ref outputs "out"))) + (symlink "emms-auto.el" + (string-append out "/share/emacs/site-lisp/" + "emms-autoloads.el"))) + #t))) + #:tests? #f)) + (native-inputs `(("emacs" ,emacs-minimal) ;for (guix build emacs-utils) + ("texinfo" ,texinfo))) + (inputs `(("alsa-utils" ,alsa-utils) + ("flac" ,flac) ;for metaflac + ("vorbis-tools" ,vorbis-tools) + ("mpg321" ,mpg321) + ("taglib" ,taglib) + ("mp3info" ,mp3info) + ("opus-tools" ,opus-tools))) + (properties '((upstream-name . "emms"))) + (synopsis "Emacs Multimedia System") + (description + "EMMS is the Emacs Multimedia System. It is a small front-end which +can control one of the supported external players. Thus, it supports +whatever formats are supported by your music player. It also +supports tagging and playlist management, all behind a clean and +light user interface.") + (home-page "https://www.gnu.org/software/emms/") + (license license:gpl3+))) + +(define-public emacs-emms-player-mpv + ;; A new mpv backend is included in Emms from 5.0. + (deprecated-package "emacs-emms-player-mpv" emacs-emms)) + +(define-public emacs-emms-mode-line-cycle + (package + (name "emacs-emms-mode-line-cycle") + (version "0.2.5") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/momomo5717/emms-mode-line-cycle" + "/archive/" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0ifszi930pnaxk1x8pcydmvnp06868gc7nfx14q17zbajbx735k6")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emms" ,emacs-emms))) + (home-page "https://github.com/momomo5717/emms-mode-line-cycle") + (synopsis "Display the EMMS mode line as a ticker") + (description + "This is a minor mode for updating the EMMS mode-line string cyclically +within a specified width. It is useful for displaying long track titles.") + (license license:gpl3+))) + + +;;; +;;; Miscellaneous. +;;; + +(define-public emacs-bbdb + (package + (name "emacs-bbdb") + (version "3.1.2") + (source (origin + (method url-fetch) + (uri (string-append "mirror://savannah/bbdb/bbdb-" + version ".tar.gz")) + (sha256 + (base32 + "1gs16bbpiiy01w9pyg12868r57kx1v3hnw04gmqsmpc40l1hyy05")) + (modules '((guix build utils))) + (snippet + ;; We don't want to build and install the PDF. + '(begin + (substitute* "doc/Makefile.in" + (("^doc_DATA = .*$") + "doc_DATA =\n")) + #t)))) + (build-system gnu-build-system) + (arguments + '(#:phases + (modify-phases %standard-phases + (add-after 'install 'post-install + (lambda* (#:key outputs #:allow-other-keys) + ;; Add an autoloads file with the right name for guix.el. + (let* ((out (assoc-ref outputs "out")) + (site (string-append out "/share/emacs/site-lisp"))) + (with-directory-excursion site + (symlink "bbdb-loaddefs.el" "bbdb-autoloads.el"))) + #t))))) + (native-inputs `(("emacs" ,emacs-minimal))) + (home-page "https://savannah.nongnu.org/projects/bbdb/") + (synopsis "Contact management utility for Emacs") + (description + "BBDB is the Insidious Big Brother Database for GNU Emacs. It provides +an address book for email and snail mail addresses, phone numbers and the +like. It can be linked with various Emacs mail clients (Message and Mail +mode, Rmail, Gnus, MH-E, and VM). BBDB is fully customizable.") + (license license:gpl3+))) + +(define-public bbdb + (deprecated-package "bbdb" emacs-bbdb)) + +(define-public emacs-aggressive-indent + (package + (name "emacs-aggressive-indent") + (version "1.8.3") + (source (origin + (method url-fetch) + (uri (string-append "https://elpa.gnu.org/packages/" + "aggressive-indent-" version ".el")) + (sha256 + (base32 + "0jnzccl50x0wapprgwxinp99pwwa6j43q6msn4gv437j7swy8wnj")))) + (build-system emacs-build-system) + (home-page "https://elpa.gnu.org/packages/aggressive-indent.html") + (synopsis "Minor mode to aggressively keep your code always indented") + (description + "@code{aggressive-indent-mode} is a minor mode that keeps your code +always indented. It reindents after every change, making it more reliable +than @code{electric-indent-mode}.") + (license license:gpl2+))) + +(define-public emacs-ag + (package + (name "emacs-ag") + (version "0.47") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/Wilfred/ag.el/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1rlmp6wnyhqfg86dbz17r914msp58favn4kd4yrdwyia265a4lar")))) + (build-system emacs-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-before 'install 'make-info + (lambda _ + (with-directory-excursion "docs" + (invoke "make" "info")))) + (add-after 'install 'install-info + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (info (string-append out "/share/info"))) + (install-file "docs/_build/texinfo/agel.info" info) + #t)))))) + (native-inputs + `(("python-sphinx" ,python-sphinx) + ("texinfo" ,texinfo))) + (propagated-inputs + `(("dash" ,emacs-dash) + ("s" ,emacs-s) + ;; We need to use 'ag' as the executable on remote systems. + ("the-silver-searcher" ,the-silver-searcher))) + (home-page "https://github.com/Wilfred/ag.el") + (synopsis "Front-end for ag (the-silver-searcher) for Emacs") + (description "This package provides the ability to use the silver +searcher, a code searching tool, sometimes abbreviated to @code{ag}. Features +include version control system awareness, use of Perl compatible regular +expressions, editing the search results directly and searching file names +rather than the contents of files.") + (license license:gpl3+))) + +(define-public emacs-async + (package + (name "emacs-async") + (home-page "https://github.com/jwiegley/emacs-async") + (version "1.9.3") + (source (origin + (method git-fetch) + (uri (git-reference + (url home-page) + (commit (string-append "v" version)))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "1zsnb6dy8p6y68xgidv3dfxaga4biramfw8fq7wac0sc50vc98vq")))) + (build-system emacs-build-system) + (synopsis "Asynchronous processing in Emacs") + (description + "This package provides the ability to call asynchronous functions and +processes. For example, it can be used to run dired commands (for copying, +moving, etc.) asynchronously using @code{dired-async-mode}. Also it is used +as a library for other Emacs packages.") + (license license:gpl3+))) + +(define-public emacs-auctex + (package + (name "emacs-auctex") + (version "12.1.0") + (source + (origin + (method url-fetch) + (uri (string-append + "https://elpa.gnu.org/packages/auctex-" + version + ".tar")) + (sha256 + (base32 + "0iy5x61xqkxaph2hq64sg50l1c6yp6qhzppwadayxkdz00b46sas")))) + (build-system emacs-build-system) + ;; We use 'emacs' because AUCTeX requires dbus at compile time + ;; ('emacs-minimal' does not provide dbus). + (arguments + `(#:emacs ,emacs + #:include '("\\.el$" "^images/" "^latex/" "\\.info$") + #:exclude '("^tests/" "^latex/README"))) + (native-inputs + `(("perl" ,perl))) + (home-page "https://www.gnu.org/software/auctex/") + (synopsis "Integrated environment for TeX") + (description + "AUCTeX is a comprehensive customizable integrated environment for +writing input files for TeX, LaTeX, ConTeXt, Texinfo, and docTeX using Emacs +or XEmacs.") + (license license:gpl3+))) + +(define-public emacs-autothemer + (package + (name "emacs-autothemer") + (version "0.2.2") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/sebastiansturm/autothemer/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0rd28r9wfrbll212am4ih9hrvypx785aff76va2cbfxdwm9kixsa")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-dash" ,emacs-dash))) + (home-page "https://github.com/sebastiansturm/autothemer") + (synopsis "Conveniently create Emacs themes") + (description + "Autothemer provides a thin layer on top of @code{deftheme} and +@code{custom-theme-set-faces} that creates a new custom color theme, based on +a set of simplified face specifications and a user-supplied color palette") + (license license:gpl3+))) + +(define-public emacs-howm + (package + (name "emacs-howm") + (version "1.4.4") + (source + (origin + (method url-fetch) + (uri (string-append "http://howm.sourceforge.jp/a/howm-" + version ".tar.gz")) + (sha256 + (base32 + "0ddm91l6z58j7x59fa966j6q1rg4cinyza4r8ibg80hprn5h31qk")))) + (build-system gnu-build-system) + (native-inputs + `(("emacs" ,emacs-minimal))) + (arguments + `(#:configure-flags + (list (string-append "--with-howmdir=" %output + "/share/emacs/site-lisp/guix.d/howm-" ,version)) + #:modules ((guix build gnu-build-system) + ((guix build emacs-build-system) #:prefix emacs:) + (guix build utils)) + #:imported-modules (,@%gnu-build-system-modules + (guix build emacs-build-system) + (guix build emacs-utils)) + #:phases + (modify-phases %standard-phases + (add-after 'install 'make-autoloads + (assoc-ref emacs:%standard-phases 'make-autoloads))))) + (home-page "http://howm.osdn.jp/") + (synopsis "Note-taking tool for Emacs") + (description "Howm is a note-taking tool for Emacs. Like +code@{emacs-wiki.el}, it facilitates using hyperlinks and doing full-text +searches. Unlike code@{emacs-wiki.el}, it can be combined with any format.") + (license license:gpl1+))) + +(define-public emacs-calfw + (package + (name "emacs-calfw") + (version "1.6") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/kiwanami/emacs-calfw/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1zr91xr0f1xfcv78yxka8vs5ximmq2ixmqf2pkb57kwwnxlypq4i")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-howm" ,emacs-howm))) + (home-page "https://github.com/kiwanami/emacs-calfw/") + (synopsis "Calendar framework for Emacs") + (description + "This package displays a calendar view with various schedule data in the +Emacs buffer.") + (license license:gpl3+))) + +(define-public emacs-direnv + (package + (name "emacs-direnv") + (version "1.2.0") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/wbolster/emacs-direnv/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0m9nxawklhiiysyibzzhh2zkxgq1fskqvaqb06f7r8dnhabfy9fr")))) + (build-system emacs-build-system) + (propagated-inputs + `(("dash" ,emacs-dash) + ("with-editor" ,emacs-with-editor))) + (home-page "https://github.com/wbolster/emacs-direnv") + (synopsis "Direnv integration for Emacs") + (description + "This package provides support for invoking direnv to get the environment +for the current file and updating the environment within Emacs to match. + +Direnv can be invoked manually, and a global minor mode is included that will +update the environment when the active buffer changes. + +Using emacs-direnv means that programs started from Emacs will use the +environment set through Direnv.") + (license license:gpl3+))) + +(define-public emacs-ggtags + (package + (name "emacs-ggtags") + (version "0.8.13") + (source + (origin + (method url-fetch) + (uri (string-append "http://elpa.gnu.org/packages/ggtags-" + version ".el")) + (sha256 + (base32 + "1qa7lcrcmf76sf6dy8sxbg4adq7rg59fm0n5848w3qxgsr0h45fg")))) + (build-system emacs-build-system) + (inputs + `(("global" ,global))) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-after 'unpack 'configure + (lambda* (#:key inputs #:allow-other-keys) + (chmod "ggtags.el" #o644) + (emacs-substitute-variables "ggtags.el" + ("ggtags-executable-directory" + (string-append (assoc-ref inputs "global") "/bin"))) + #t))))) + (home-page "https://github.com/leoliu/ggtags") + (synopsis "Frontend to the GNU Global source code tagging system") + (description "@code{ggtags} provides a frontend to the GNU Global source +code tagging system. + +Features: + +@itemize +@item Build on @code{compile.el} for asynchronicity and its large feature-set. +@item Automatically update Global's tag files when needed with tuning for +large source trees. +@item Intuitive navigation among multiple matches with mode-line display of +current match, total matches and exit status. +@item Read tag with completion. +@item Show definition at point. +@item Jump to #include files. +@item Support search history and saving a search to register/bookmark. +@item Query replace. +@item Manage Global's environment variables on a per-project basis. +@item Highlight (definition) tag at point. +@item Abbreviated display of file names. +@item Support all Global search backends: @code{grep}, @code{idutils}, etc. +@item Support exuberant ctags @url{http://ctags.sourceforge.net/} and +@code{pygments} backend. +@item Support all Global's output formats: @code{grep}, @code{ctags-x}, +@code{cscope} etc. +@item Support projects on remote hosts (e.g. via @code{tramp}). +@item Support eldoc. +@item Search @code{GTAGSLIBPATH} for references and symbols. +@end itemize\n") + (license license:gpl3+))) + +(define-public emacs-go-mode + (package + (name "emacs-go-mode") + (version "1.5.0") + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/dominikh/go-mode.el.git") + (commit (string-append "v" version)))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "1nd2h50yb0493wvf1h7fzplq45rmqn2w7kxpgnlxzhkvq99v8vzf")))) + (build-system emacs-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-after 'unpack 'make-writable + (lambda _ + (for-each make-file-writable (find-files "." "\\.el$")) + #t))))) + (home-page "https://github.com/dominikh/go-mode.el") + (synopsis "Go mode for Emacs") + (description + "This package provides go-mode, an Emacs mode for working with software +written in the Go programming language.") + (license license:bsd-3))) + +(define-public emacs-google-maps + (package + (name "emacs-google-maps") + (version "1.0.0") + (source (origin + (method url-fetch) + (uri (string-append "https://github.com/jd/google-maps.el/" + "archive/" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "014bxapm4d8vjxbzrfjdpsavxyfx981mlcb10aq5rmigr6il8ybs")))) + (build-system emacs-build-system) + (home-page "https://github.com/jd/google-maps.el") + (synopsis "Access Google Maps from Emacs") + (description "The @code{google-maps} package allows to display Google +Maps directly inside Emacs.") + (license license:gpl3+))) + +(define-public emacs-graphviz-dot-mode + (let ((commit "c456a2b65c734089e6c44e87209a5a432a741b1a") + (revision "1")) + (package + (name "emacs-graphviz-dot-mode") + (version (string-append "0.3.11-" revision "." + (string-take commit 7))) + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/ppareit/graphviz-dot-mode.git") + (commit commit))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "0j1r2rspaakw37b0mx7pwpvdsvixq9sw3xjbww5piihzpdxz58z1")))) + (build-system emacs-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-before 'install 'make-info + (lambda* (#:key inputs #:allow-other-keys) + (with-directory-excursion "texinfo" + (substitute* "Makefile" + (("\\/usr\\/bin\\/gzip") + (string-append (assoc-ref inputs "gzip") "/bin/gzip"))) + (invoke "make" + "clean" + "info" + (string-append "TEXINFODIR=" + (assoc-ref inputs "texinfo") + "/bin"))))) + (add-after 'install 'install-info + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (info (string-append out "/share/info"))) + (install-file "texinfo/graphviz-dot-mode.info.gz" info) + #t)))))) + (native-inputs + `(("texinfo" ,texinfo) + ("gzip" ,gzip))) + (home-page "http://ppareit.github.com/graphviz-dot-mode") + (synopsis "Major mode for editing Graphviz Dot files") + (description + "This Emacs packages helps you to create @file{.dot} or @file{.gv} +files using the dot syntax, and use Graphviz to convert these files to +diagrams.") + (license license:gpl2+)))) + +(define-public emacs-mmm-mode + (package + (name "emacs-mmm-mode") + (version "0.5.5") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/purcell/mmm-mode/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0c5ing3hcr74k78hqhrfwiv6m3n8hqfrw89j2x34vf60f4iyqzqc")))) + (build-system gnu-build-system) + (arguments + '(#:phases + (modify-phases %standard-phases + (add-after 'unpack 'autogen + (lambda _ + (invoke "sh" "autogen.sh")))))) + (native-inputs + `(("autoconf" ,autoconf) + ("automake" ,automake) + ("emacs" ,emacs-minimal) + ("texinfo" ,texinfo))) + (home-page "https://github.com/purcell/mmm-mode") + (synopsis "Allow multiple major modes in an Emacs buffer") + (description + "MMM Mode is a minor mode that allows multiple major modes to coexist in a +single buffer.") + (license license:gpl3+))) + +(define-public emacs-tablist + (package + (name "emacs-tablist") + (version "0.70") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/politza/tablist/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "177d6s7ym1mwz1nhnl09r14z3n093g9a2szm97xsaig0c204xz9c")))) + (build-system emacs-build-system) + (home-page "https://github.com/politza/tablist") + (synopsis "Extension for @code{tabulated-list-mode}") + (description "Tablist is the Emacs package that provides several +additional features to @code{tabulated-list-mode}: it adds marks, +filters, new key bindings and faces. It can be enabled by +@code{tablist-mode} or @code{tablist-minor-mode} commands.") + (license license:gpl3+))) + +(define-public emacs-pdf-tools + (package + (name "emacs-pdf-tools") + (version "0.80") + (home-page "https://github.com/politza/pdf-tools") + (source (origin + (method git-fetch) + (uri (git-reference (url home-page) + (commit (string-append "v" version)))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "1i4647vax5na73basc5dz4lh9kprir00fh8ps4i0l1y3ippnjs2s")) + (patches (search-patches "emacs-pdf-tools-poppler.patch")))) + (build-system gnu-build-system) + (arguments + `(#:tests? #f ; there are no tests + #:modules ((guix build gnu-build-system) + ((guix build emacs-build-system) #:prefix emacs:) + (guix build utils) + (guix build emacs-utils)) + #:imported-modules (,@%gnu-build-system-modules + (guix build emacs-build-system) + (guix build emacs-utils)) + #:phases + (modify-phases %standard-phases + ;; Build server side using 'gnu-build-system'. + (add-after 'unpack 'enter-server-dir + (lambda _ (chdir "server") #t)) + (add-after 'enter-server-dir 'autogen + (lambda _ + (invoke "bash" "autogen.sh"))) + + ;; Build emacs side using 'emacs-build-system'. + (add-after 'compress-documentation 'enter-lisp-dir + (lambda _ (chdir "../lisp") #t)) + (add-after 'enter-lisp-dir 'emacs-patch-variables + (lambda* (#:key outputs #:allow-other-keys) + (for-each make-file-writable (find-files ".")) + + ;; Set path to epdfinfo program. + (emacs-substitute-variables "pdf-info.el" + ("pdf-info-epdfinfo-program" + (string-append (assoc-ref outputs "out") + "/bin/epdfinfo"))) + ;; Set 'pdf-tools-handle-upgrades' to nil to avoid "auto + ;; upgrading" that pdf-tools tries to perform. + (emacs-substitute-variables "pdf-tools.el" + ("pdf-tools-handle-upgrades" '())))) + (add-after 'emacs-patch-variables 'emacs-set-emacs-load-path + (assoc-ref emacs:%standard-phases 'set-emacs-load-path)) + (add-after 'emacs-set-emacs-load-path 'emacs-install + (assoc-ref emacs:%standard-phases 'install)) + (add-after 'emacs-install 'emacs-build + (assoc-ref emacs:%standard-phases 'build)) + (add-after 'emacs-install 'emacs-make-autoloads + (assoc-ref emacs:%standard-phases 'make-autoloads))))) + (native-inputs `(("autoconf" ,autoconf) + ("automake" ,automake) + ("pkg-config" ,pkg-config) + ("emacs" ,emacs-minimal))) + (inputs `(("poppler" ,poppler) + ("cairo" ,cairo) + ("glib" ,glib) + ("libpng" ,libpng) + ("zlib" ,zlib))) + (propagated-inputs `(("tablist" ,emacs-tablist))) + (synopsis "Emacs support library for PDF files") + (description + "PDF Tools is, among other things, a replacement of DocView for PDF +files. The key difference is that pages are not pre-rendered by +e.g. ghostscript and stored in the file-system, but rather created on-demand +and stored in memory.") + (license license:gpl3+))) + +(define-public emacs-dash + (package + (name "emacs-dash") + (version "2.14.1") + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/magnars/dash.el.git") + (commit version))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "1kzijmjxjxgr7p8clphzvmm47vczckbs8mza9an77c25bn627ywl")))) + (build-system emacs-build-system) + (arguments + `(#:tests? #t + #:test-command '("./run-tests.sh"))) + (home-page "https://github.com/magnars/dash.el") + (synopsis "Modern list library for Emacs") + (description "This package provides a modern list API library for Emacs.") + (license license:gpl3+))) + +(define-public emacs-bui + (package + (name "emacs-bui") + (version "1.2.1") + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://notabug.org/alezost/emacs-bui.git") + (commit (string-append "v" version)))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "0sszdl4kvqbihdh8d7mybpp0d8yw2p3gyiipjcxz9xhvvmw3ww4x")))) + (build-system emacs-build-system) + (propagated-inputs + `(("dash" ,emacs-dash))) + (home-page "https://notabug.org/alezost/emacs-bui") + (synopsis "Buffer interface library for Emacs") + (description + "BUI (Buffer User Interface) is a library for making @code{list} and +@code{info} interfaces to display an arbitrary data of the same +type, for example: packages, buffers, files, etc.") + (license license:gpl3+))) + +(define-public emacs-guix + (package + (name "emacs-guix") + (version "0.5.1.1") + (source (origin + (method url-fetch) + (uri (string-append "https://emacs-guix.gitlab.io/website/" + "releases/emacs-guix-" version ".tar.gz")) + (sha256 + (base32 + "1gxg7lan3njc2yg2d02b2zij0d2cm2pv2q08nqz86s85jk3b6m03")))) + (build-system gnu-build-system) + (arguments + `(#:configure-flags + (let ((guix (assoc-ref %build-inputs "guix")) + (gcrypt (assoc-ref %build-inputs "guile-gcrypt")) + (geiser (assoc-ref %build-inputs "geiser")) + (dash (assoc-ref %build-inputs "dash")) + (bui (assoc-ref %build-inputs "bui")) + (magit-popup (assoc-ref %build-inputs "magit-popup")) + (edit-indirect (assoc-ref %build-inputs "edit-indirect")) + (site-lisp "/share/emacs/site-lisp") + (site-scm "/share/guile/site") + (site-go "/lib/guile") + (guile-dir (lambda (dir) + (car (find-files dir + (lambda (file stat) + (string-prefix? + "2." (basename file))) + #:directories? #t))))) + (list (string-append "--with-guix-site-dir=" + (guile-dir (string-append guix site-scm))) + (string-append "--with-guix-site-ccache-dir=" + (guile-dir (string-append guix site-go)) + "/site-ccache") + (string-append "--with-guile-gcrypt-site-dir=" + (guile-dir (string-append gcrypt site-scm))) + (string-append "--with-guile-gcrypt-site-ccache-dir=" + (guile-dir (string-append gcrypt site-go)) + "/site-ccache") + (string-append "--with-geiser-lispdir=" geiser site-lisp) + (string-append "--with-dash-lispdir=" + dash site-lisp "/guix.d/dash-" + ,(package-version emacs-dash)) + (string-append "--with-bui-lispdir=" + bui site-lisp "/guix.d/bui-" + ,(package-version emacs-bui)) + (string-append "--with-editindirect-lispdir=" + edit-indirect site-lisp "/guix.d/edit-indirect-" + ,(package-version emacs-edit-indirect)) + (string-append "--with-popup-lispdir=" + magit-popup site-lisp "/guix.d/magit-popup-" + ,(package-version emacs-magit-popup)))))) + (native-inputs + `(("pkg-config" ,pkg-config) + ("emacs" ,emacs-minimal))) + (inputs + `(("guile" ,guile-2.2) + ("guix" ,guix))) + (propagated-inputs + `(("geiser" ,emacs-geiser) + ("guile-gcrypt" ,guile-gcrypt) + ("dash" ,emacs-dash) + ("bui" ,emacs-bui) + ("edit-indirect" ,emacs-edit-indirect) + ("magit-popup" ,emacs-magit-popup))) + (home-page "https://emacs-guix.gitlab.io/website/") + (synopsis "Emacs interface for GNU Guix") + (description + "Emacs-Guix provides a visual interface, tools and features for the GNU +Guix package manager. Particularly, it allows you to do various package +management tasks from Emacs. To begin with, run @code{M-x guix-about} or +@code{M-x guix-help} command.") + (license license:gpl3+))) + +(define-public emacs-build-farm + (package + (name "emacs-build-farm") + (version "0.2.2") + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://notabug.org/alezost/emacs-build-farm.git") + (commit (string-append "v" version)))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "0i0bwbav5861j2y15j9nd5m9rdqg9q97zgcbld8pivr9nyxy63lz")))) + (build-system emacs-build-system) + (propagated-inputs + `(("bui" ,emacs-bui) + ("magit-popup" ,emacs-magit-popup))) + (home-page "https://notabug.org/alezost/emacs-build-farm") + (synopsis "Emacs interface for Hydra and Cuirass build farms") + (description + "This Emacs package provides an interface for Hydra and +Cuirass (build farms used by Nix and Guix). It allows you to look at +various data related to the build farm projects, jobsets, builds and +evaluations. The entry point is @code{M-x build-farm} command.") + (license license:gpl3+))) + +(define-public emacs-d-mode + (package + (name "emacs-d-mode") + (version "2.0.9") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/Emacs-D-Mode-Maintainers/Emacs-D-Mode/" + "archive/" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "127aa77ix3p7w4g339bx026df9y649dahlr3v359z0hs40zjz3kd")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-undercover" ,emacs-undercover))) + (home-page "https://github.com/Emacs-D-Mode-Maintainers/Emacs-D-Mode") + (synopsis "Emacs major mode for editing D code") + (description "This package provides an Emacs major mode for highlighting +code written in the D programming language. This mode is currently known to +work with Emacs 24 and 25.") + (license license:gpl2+))) + +(define-public emacs-keyfreq + (package + (name "emacs-keyfreq") + (version "20160516.716") + (source + (origin + (method url-fetch) + (uri (string-append "http://melpa.org/packages/keyfreq-" + version ".el")) + (sha256 + (base32 + "008hd7d06qskc3mx0bbdgpgy2pwxr8185fzlyqf9qjg49y74p6g8")))) + (build-system emacs-build-system) + (home-page "https://github.com/dacap/keyfreq") + (synopsis "Track Emacs command frequencies") + (description "@code{emacs-keyfeq} tracks and shows how many times you used +a command.") + (license license:gpl3+))) + +(define-public emacs-olivetti + (package + (name "emacs-olivetti") + (version "1.5.7") + (source (origin + (method url-fetch) + (uri (string-append + "https://stable.melpa.org/packages/olivetti-" + version ".el")) + (sha256 + (base32 + "1yj2ylg46q0pw1xzlv2b0fv9x8p56x25284s9v2smwjr4vf0nwcj")))) + (build-system emacs-build-system) + (home-page "https://github.com/rnkn/olivetti") + (synopsis "Emacs minor mode for a nice writing environment") + (description "This package provides an Emacs minor mode that puts writing +in the center.") + (license license:gpl3+))) + +(define-public emacs-undo-tree + (package + (name "emacs-undo-tree") + (version "0.6.6") + (source (origin + (method git-fetch) + (uri (git-reference + (url "http://dr-qubit.org/git/undo-tree.git") + (commit (string-append "release/" version)))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "1hnh2mnmw179gr094r561w6cw1haid0lpvpqvkc24wpj82vphzpa")))) + (build-system emacs-build-system) + (home-page "http://www.dr-qubit.org/emacs.php") + (synopsis "Treat undo history as a tree") + (description "Tree-like interface to Emacs undo system, providing +graphical tree presentation of all previous states of buffer that +allows easily move between them.") + (license license:gpl3+))) + +(define-public emacs-s + (package + (name "emacs-s") + (version "1.12.0") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/magnars/s.el/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0xbl75863pcm806zg0x1lw7qznzjq2c8320k8js7apyag8q4srvh")))) + (build-system emacs-build-system) + (arguments + `(#:tests? #t + #:emacs ,emacs ; FIXME: tests fail with emacs-minimal + #:test-command '("./run-tests.sh"))) + (home-page "https://github.com/magnars/s.el") + (synopsis "Emacs string manipulation library") + (description "This package provides an Emacs library for manipulating +strings.") + (license license:gpl3+))) + +(define-public emacs-symon + (package + (name "emacs-symon") + (version "20160630") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/zk-phi/symon/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0h4jcgdnq98wc9rj72nwyazq8498yg55jfljiij5qwbn1xf1g5zz")))) + (build-system emacs-build-system) + (home-page "https://github.com/zk-phi/symon") + (synopsis "Tiny graphical system monitor") + (description + "Tiny graphical system monitor for the Emacs minibuffer when idle.") + (license license:gpl2+))) + +(define-public emacs-sx + (let ((version "20180212") + (revision "1") + (commit "833435fbf90d1c9e927d165b155f3b1ef39271de")) + (package + (name "emacs-sx") + (version (git-version version revision commit)) + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/vermiculus/sx.el") + (commit commit))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "1369xaxq1vy3d9yh862ddnhddikdpg2d0wv1ly00pnvdp9v4cqgd")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-markdown-mode" ,emacs-markdown-mode))) + (home-page "https://github.com/vermiculus/sx.el") + (synopsis "Emacs StackExchange client") + (description + "Emacs StackExchange client. Ask and answer questions on +Stack Overflow, Super User, and other StackExchange sites.") + (license license:gpl3+)))) + +(define-public emacs-f + (package + (name "emacs-f") + (version "0.20.0") + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/rejeep/f.el.git") + (commit (string-append "v" version)))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "1a47xk3yp1rp17fqg7ldl3d3fb888h0fz3sysqfdz1bfdgs8a9bk")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-s" ,emacs-s) + ("emacs-dash" ,emacs-dash))) + (home-page "https://github.com/rejeep/f.el") + (synopsis "Emacs API for working with files and directories") + (description "This package provides an Emacs library for working with +files and directories.") + (license license:gpl3+))) + +(define-public emacs-git-gutter + (package + (name "emacs-git-gutter") + (version "0.90") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/syohex/" name "/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1nmhvhpq1l56mj2yq3ag23rw3x4xgnsy8szp30s26l0yjnkhc4qg")))) + (build-system emacs-build-system) + (home-page "https://github.com/syohex/emacs-git-gutter") + (synopsis "See and manage hunks of text in a version control system") + (description + "This package is an Emacs minor mode for displaying and interacting with +hunks of text managed in a version control system. Added modified and deleted +areas can be indicated with symbols on the edge of the buffer, and commands +can be used to move between and perform actions on these hunks. + +Git, Mercurial, Subversion and Bazaar are supported, and many parts of the +display and behaviour is easily customisable.") + (license license:gpl3+))) + +(define-public emacs-git-timemachine + (package + (name "emacs-git-timemachine") + (version "4.5") + (source + (origin + (method url-fetch) + (uri (string-append "https://gitlab.com/pidu/git-timemachine" + "/-/archive/" version + "/git-timemachine-" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0ii40qcincasg7s1yrvqcxkqcqzb4sfs7gcxscn6m4x4ans165zy")))) + (build-system emacs-build-system) + (home-page "https://gitlab.com/pidu/git-timemachine") + (synopsis "Step through historic versions of Git-controlled files") + (description "This package enables you to step through historic versions +of files under Git version control from within Emacs.") + (license license:gpl3+))) + +(define-public emacs-minitest + (let ((commit "1aadb7865c1dc69c201cecee275751ecec33a182") + (revision "1")) + (package + (name "emacs-minitest") + (version (git-version "0.8.0" revision commit)) + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/arthurnn/minitest-emacs") + (commit commit))) + (file-name (git-file-name name commit)) + (sha256 + (base32 + "1l18zqpdzbnqj2qawq8hj7z7pl8hr8z9d8ihy8jaiqma915hmhj1")))) + (build-system emacs-build-system) + (arguments + '(#:include (cons "^snippets\\/minitest-mode\\/" %default-include) + #:exclude (delete "^[^/]*tests?\\.el$" %default-exclude))) + (propagated-inputs + `(("emacs-dash" ,emacs-dash) + ("emacs-f" ,emacs-f))) + (home-page "https://github.com/arthurnn/minitest-emacs") + (synopsis "Emacs minitest mode") + (description + "The minitest mode provides commands to run the tests for the current +file or line, as well as rerunning the previous tests, or all the tests for a +project. + +This package also includes relevant snippets for yasnippet.") + (license license:expat)))) + +(define-public emacs-el-mock + (package + (name "emacs-el-mock") + (version "1.25.1") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/rejeep/el-mock.el/" + "archive/v" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "16xw94n58xxn3zvgyj72bmzs0k5lkvswjmzs79ws9n7rzdivb38b")))) + (build-system emacs-build-system) + (home-page "https://github.com/rejeep/el-mock.el") + (synopsis "Tiny mock and stub framework in Emacs Lisp") + (description + "Emacs Lisp Mock is a library for mocking and stubbing using readable +syntax. Most commonly Emacs Lisp Mock is used in conjunction with Emacs Lisp +Expectations, but it can be used in other contexts.") + (license license:gpl3+))) + +(define-public emacs-espuds + (package + (name "emacs-espuds") + (version "0.3.3") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/ecukes/espuds/" + "archive/v" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0xv551376pbmh735a3zjwc9z4qdx6ngj1vpq3xqjpn0a1rwjyn4k")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-s" ,emacs-s) + ("emacs-dash" ,emacs-dash) + ("emacs-f" ,emacs-f))) + (home-page "https://github.com/ecukes/espuds") + (synopsis "Common step definitions for Ecukes") + (description "Espuds is a collection of the most commonly used step +definitions for testing with the Ecukes framework.") + (license license:gpl3+))) + +(define-public emacs-spark + (let ((version "20160503") ; no proper tag, use date of commit + (commit "0bf148c3ede3b31d56fd75f347cdd0b0eae60025") + (revision "1")) + (package + (name "emacs-spark") + (version (git-version version revision commit)) + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/alvinfrancis/spark.git") + (commit commit))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "1ykqr86j17mi95s08d9fp02d7ych1331b04dcqxzxnmpkhwngyj1")))) + (build-system emacs-build-system) + (home-page "https://github.com/alvinfrancis/spark") + (synopsis "Sparkline generation library for Emacs Lisp") + (description "@code{emacs-spark} is a sparkline generation library for +Emacs Lisp. It generates a sparkline string given a list of numbers. It is a +port of @code{cl-spark} to Emacs Lisp.") + (license license:expat)))) + +(define-public emacs-es-mode + (package + (name "emacs-es-mode") + (version "4.3.0") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/dakrone/es-mode/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0y86qdcb3g7fkcb4pzsjh3syzql6w3314hg1wqxq4a8bbk3y0cgr")))) + (build-system emacs-build-system) + (propagated-inputs + ;; The version of org in Emacs 24.5 is not sufficient, and causes tables + ;; to be rendered incorrectly + `(("emacs-dash" ,emacs-dash) + ("emacs-org" ,emacs-org) + ("emacs-spark" ,emacs-spark))) + (home-page "https://github.com/dakrone/es-mode") + (synopsis "Major mode for editing Elasticsearch queries") + (description "@code{es-mode} includes highlighting, completion and +indentation support for Elasticsearch queries. Also supported are +@code{es-mode} blocks in @code{org-mode}, for which the results of queries can +be processed through @code{jq}, or in the case of aggregations, can be +rendered in to a table. In addition, there is an @code{es-command-center} +mode, which displays information about Elasticsearch clusters.") + (license license:gpl3+))) + +(define-public emacs-expand-region + (package + (name "emacs-expand-region") + (version "0.11.0") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/magnars/expand-region.el" + "/archive/" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "08dy1f411sh9wwww53rjw80idcf3vpki6ba2arl4hl5jcw9651g0")))) + (build-system emacs-build-system) + (home-page "https://github.com/magnars/expand-region.el") + (synopsis "Increase selected region by semantic units") + (description + "Expand region increases the selected region by semantic units. Just +keep pressing the key until it selects what you want. There's also +@code{er/contract-region} if you expand too far.") + (license license:gpl3+))) + +(define-public emacs-fill-column-indicator + (package + (name "emacs-fill-column-indicator") + (version "1.89") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/alpaker/Fill-Column-Indicator" + "/archive/v" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "09ab01np14bdcsr38xf95kpnvxzqr46mdjmphg3pigwnx39a3jvg")))) + (build-system emacs-build-system) + (home-page "https://www.emacswiki.org/emacs/FillColumnIndicator") + (synopsis "Graphically indicate the fill column") + (description + "Fill-column-indicator graphically indicates the location of the fill +column by drawing a thin line down the length of the editing window.") + (license license:gpl3+))) + +(define-public emacs-grep-a-lot + (package + (name "emacs-grep-a-lot") + (version "1.0.7") + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/ZungBang/emacs-grep-a-lot.git") + (commit "9f9f645b9e308a0d887b66864ff97d0fca1ba4ad"))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "1f8262mrlinzgnn4m49hbj1hm3c1mvzza24py4b37sasn49546lw")))) + (build-system emacs-build-system) + (home-page "https://github.com/ZungBang/emacs-grep-a-lot") + (synopsis "Enables multiple grep buffers in Emacs") + (description + "This Emacs package allows managing multiple grep buffers.") + (license license:gpl3+))) + +(define-public emacs-inf-ruby + (package + (name "emacs-inf-ruby") + (version "2.5.1") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/nonsequitur/inf-ruby/" + "archive/" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0m7323k649ckxql1grsdnf71bjhys7l4qb8wbpphb1mr1q8i4066")))) + (build-system emacs-build-system) + (home-page "https://github.com/nonsequitur/inf-ruby") + (synopsis "Provides a REPL buffer connected to a Ruby subprocess in Emacs") + (description + "@code{inf-ruby} provides a Read Eval Print Loop (REPL) buffer, allowing +for easy interaction with a ruby subprocess. Features include support for +detecting specific uses of Ruby, e.g. when using rails, and using a +appropriate console.") + (license license:gpl3+))) + +(define-public emacs-znc + (package + (name "emacs-znc") + (version "0.0.2") + (source + (origin + (method url-fetch) + (uri (string-append "https://marmalade-repo.org/packages/znc-" + version ".el")) + (sha256 + (base32 + "1d8lqvybgyazin5z0g1c4l3rg1vzrrvf0saqs53jr1zcdg0lianh")))) + (build-system emacs-build-system) + (home-page "https://github.com/sshirokov/ZNC.el") + (synopsis "Make ERC and ZNC get along better") + (description + "This is a thin wrapper around @code{erc} that enables one to use the ZNC +IRC bouncer with ERC.") + (license license:expat))) + +(define-public emacs-shut-up + (package + (name "emacs-shut-up") + (version "0.3.2") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/cask/shut-up/" + "archive/v" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "09kzrjdkb569iviyg7ydwq44yh84m3f9hkl7jizfrlk0w4gz67d1")))) + (build-system emacs-build-system) + (home-page "https://github.com/cask/shut-up") + (synopsis "Silence Emacs") + (description "This package silences most output of Emacs when running an +Emacs shell script.") + (license license:expat))) + +(define-public emacs-undercover + (package + (name "emacs-undercover") + (version "0.6.0") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/sviridov/undercover.el/" + "archive/v" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0f48fi0xnbsqs382rgh85m9mq1wdnr0yib7as9xhwzvq0hsr5m0a")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-dash" ,emacs-dash) + ("emacs-shut-up" ,emacs-shut-up))) + (home-page "https://github.com/sviridov/undercover.el") + (synopsis "Test coverage library for Emacs Lisp") + (description + "Undercover is a test coverage library for software written in Emacs +Lisp.") + (license license:expat))) + +(define-public emacs-paren-face + (package + (name "emacs-paren-face") + (version "1.0.0") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/tarsius/paren-face/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0y4qrhxa9332vsvr999jg7qj1ymnfgwpf591yi4a4jgg90pm7qnn")))) + (build-system emacs-build-system) + (home-page "https://github.com/tarsius/paren-face") + (synopsis "Face for parentheses in lisp modes") + (description + "This library defines a face named @code{parenthesis} used just for +parentheses. The intended purpose of this face is to make parentheses less +visible in Lisp code by dimming them. Lispers probably don't need to be +constantly made aware of the existence of the parentheses. Dimming them might +be even more useful for people new to lisp who have not yet learned to +subconsciously blend out the parentheses.") + (license license:gpl3+))) + +(define-public emacs-page-break-lines + (package + (name "emacs-page-break-lines") + (version "0.11") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/purcell/page-break-lines/" + "archive/" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1zzhziq5kbrm9rxk30kx2glz455fp1blqxg8cpcf6l8xl3w8z4pg")))) + (build-system emacs-build-system) + (home-page "https://github.com/purcell/page-break-lines") + (synopsis "Display page breaks as tidy horizontal lines") + (description + "This library provides a global mode which displays form feed characters +as horizontal rules.") + (license license:gpl3+))) + +(define-public emacs-simple-httpd + (package + (name "emacs-simple-httpd") + (version "1.4.6") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/skeeto/emacs-web-server/" + "archive/" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "01r7h3imnj4qx1m53a2wjafvbylcyz5f9r2rg2cs7ky3chlg220r")))) + (build-system emacs-build-system) + (home-page "https://github.com/skeeto/emacs-http-server") + (synopsis "HTTP server in pure Emacs Lisp") + (description + "This package provides a simple HTTP server written in Emacs Lisp to +serve files and directory listings.") + (license license:unlicense))) + +(define-public emacs-skewer-mode + (package + (name "emacs-skewer-mode") + (version "1.6.2") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/skeeto/skewer-mode/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "07jpz374j0j964szy3zznrkyja2kpdl3xa87wh7349mzxivqxdx0")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-simple-httpd" ,emacs-simple-httpd) + ("emacs-js2-mode" ,emacs-js2-mode))) + (arguments '(#:include '("\\.el$" "\\.js$" "\\.html$"))) + (home-page "https://github.com/skeeto/skewer-mode") + (synopsis "Live web development in Emacs") + (description + "Skewer-mode provides live interaction with JavaScript, CSS, and HTML in +a web browser. Expressions are sent on-the-fly from an editing buffer to be +evaluated in the browser, just like Emacs does with an inferior Lisp process +in Lisp modes.") + (license license:unlicense))) + +(define-public emacs-string-inflection + (package + (name "emacs-string-inflection") + (version "1.0.6") + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/akicho8/string-inflection") + (commit "a150e7bdda60b7824d3a936750ce23f73b0e4edd"))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "1k0sm552iawi49v4zis6dbb81d1rzgky9v0dpv7nj31gnb7bmy7k")))) + (build-system emacs-build-system) + (native-inputs + `(("ert-runner" ,emacs-ert-runner))) + (arguments + `(#:tests? #t + #:test-command '("ert-runner"))) + (home-page "https://github.com/akicho8/string-inflection") + (synopsis "Convert symbol names between different naming conventions") + (description + "This Emacs package provides convenient methods for manipulating the +naming style of a symbol. It supports different naming conventions such as: + +@enumerate +@item camel case +@item Pascal case +@item all upper case +@item lower case separated by underscore +@item etc... +@end enumerate\n") + (license license:gpl2+))) + +(define-public emacs-stripe-buffer + (package + (name "emacs-stripe-buffer") + (version "0.2.5") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/sabof/stripe-buffer/" + "archive/" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1p515dq7raly5hw94kiwm3vzsfih0d8af622q4ipvvljsm98aiik")))) + (build-system emacs-build-system) + (home-page "https://github.com/sabof/stripe-buffer/") + (synopsis "Add stripes to list buffers") + (description + "This Emacs package adds faces to add stripes to list buffers and org +tables.") + (license license:gpl2+))) + +(define-public emacs-rich-minority + (package + (name "emacs-rich-minority") + (version "1.0.1") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/Malabarba/rich-minority/" + "archive/" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1l0cb0q7kyi88nwfqd542psnkgwnjklpzc5rx32gzd3lkwkrbr8v")))) + (build-system emacs-build-system) + (home-page "https://github.com/Malabarba/rich-minority") + (synopsis "Clean-up and beautify the list of minor modes") + (description + "This Emacs package hides and/or highlights minor modes in the +mode-line.") + (license license:gpl2+))) + +(define-public emacs-robe + (package + (name "emacs-robe") + (version "0.8.1") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/dgutov/robe/" + "archive/" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1vp45y99fwj88z04ah4yppz4z568qcib646az6m9az5ar0f203br")))) + (build-system emacs-build-system) + (arguments + '(#:include (cons "^lib\\/" %default-include))) + (propagated-inputs + `(("emacs-inf-ruby" ,emacs-inf-ruby))) + (home-page "https://github.com/dgutov/robe") + (synopsis "Ruby code assistance tool for Emacs") + (description + "Robe can provide information on loaded classes and modules in Ruby code, +as well as where methods are defined. This allows the user to jump to method +definitions, modules and classes, display method documentation and provide +method and constant name completion.") + (license license:gpl3+))) + +(define-public emacs-rspec + (package + (name "emacs-rspec") + (version "1.11") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/pezra/rspec-mode/" + "archive/v" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1j0a7ms5516nlg60qfyn730pfxys6acm0rgyxh5xfkpi6jafgpvw")))) + (build-system emacs-build-system) + (home-page "https://github.com/pezra/rspec-mode") + (synopsis "Provides a rspec mode for working with RSpec") + (description + "The Emacs RSpec mode provides keybindings for Ruby source files, e.g. to +verify the spec associated with the current buffer, or entire project, as well +as moving between the spec files, and coresponding code files. + +Also included are keybindings for spec files and Dired buffers, as well as +snippets for yasnippet.") + (license license:gpl3+))) + +(define-public emacs-smart-mode-line + (package + (name "emacs-smart-mode-line") + (version "2.12.0") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/Malabarba/smart-mode-line/" + "archive/" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1hn8s6laijmg7w1bgwdfrki6h9vxkbgr8rmmssvd5yqyad5w2sba")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-rich-minority" ,emacs-rich-minority))) + (home-page "https://github.com/Malabarba/smart-mode-line") + (synopsis "Color-coded smart mode-line") + (description + "Smart Mode Line is a mode-line theme for Emacs. It aims to be easy to +read from small to large monitors by using colors, a prefix feature, and smart +truncation.") + (license license:gpl2+))) + +(define-public emacs-sr-speedbar + (let ((commit "77a83fb50f763a465c021eca7343243f465b4a47") + (revision "0")) + (package + (name "emacs-sr-speedbar") + (version (git-version "20161025" revision commit)) + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/emacsorphanage/sr-speedbar.git") + (commit commit))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "0sd12555hk7z721y00kv3crdybvcn1i08wmd148z5imayzibj153")))) + (build-system emacs-build-system) + (home-page "https://www.emacswiki.org/emacs/SrSpeedbar") + (synopsis "Same frame Emacs @code{speedbar}") + (description + "This Emacs package allows you to show @code{M-x speedbar} in the +same frame (in an extra window). You can customize the initial width of +the speedbar window.") + (license license:gpl3+)))) + +(define-public emacs-shell-switcher + (package + (name "emacs-shell-switcher") + (version "1.0.1") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/DamienCassou/shell-switcher" + "/archive/v" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1c23mfkdqz2g9rixd9smm323vzlvhzz3ng34ambcqjfq309qb2nz")))) + (build-system emacs-build-system) + (home-page "https://github.com/DamienCassou/shell-switcher") + (synopsis "Provide fast switching between shell buffers") + (description + "This package provides commands to quickly switch between shell buffers.") + (license license:gpl3+))) + +(define-public emacs-ob-ipython + (package + (name "emacs-ob-ipython") + (version "20150704.8807064693") + (source (origin + (method git-fetch) + (uri (git-reference + (commit "880706469338ab59b5bb7dbe8460016f89755364") + (url "https://github.com/gregsexton/ob-ipython.git"))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "1scf25snbds9ymagpny30ijbsg479r3nm0ih01dy4m9d0g7qryb7")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-f" ,emacs-f))) + (home-page "http://www.gregsexton.org") + (synopsis "Org-Babel functions for IPython evaluation") + (description "This package adds support to Org-Babel for evaluating Python +source code using IPython.") + (license license:gpl3+))) + +(define-public emacs-debbugs + (package + (name "emacs-debbugs") + (version "0.16") + (source (origin + (method url-fetch) + (uri (string-append "https://elpa.gnu.org/packages/debbugs-" + version ".tar")) + (sha256 + (base32 + "0y3bq803c7820h15g66d1648skxfhlfa2v6vincj6xk5ssp44s9p")))) + (build-system emacs-build-system) + (arguments '(#:include '("\\.el$" "\\.wsdl$" "\\.info$"))) + (propagated-inputs + `(("emacs-async" ,emacs-async))) + (home-page "https://elpa.gnu.org/packages/debbugs.html") + (synopsis "Access the Debbugs bug tracker in Emacs") + (description + "This package lets you access the @uref{http://bugs.gnu.org,GNU Bug +Tracker} from within Emacs. + +For instance, it defines the command @code{M-x debbugs-gnu} for listing bugs, +and the command @code{M-x debbugs-gnu-search} for bug searching. If you +prefer the listing of bugs as TODO items of @code{org-mode}, you could use +@code{M-x debbugs-org} and related commands. + +A minor mode @code{debbugs-browse-mode} let you browse URLs to the GNU Bug +Tracker as well as bug identifiers prepared for @code{bug-reference-mode}.") + (license license:gpl3+))) + +(define-public emacs-ert-expectations + (package + (name "emacs-ert-expectations") + (version "0.2") + (source + (origin + (method url-fetch) + (uri "https://www.emacswiki.org/emacs/download/ert-expectations.el") + (sha256 + (base32 + "0cwy3ilsid90abzzjb7ha2blq9kmv3gfp3icwwfcz6qczgirq6g7")))) + (build-system emacs-build-system) + (home-page "https://www.emacswiki.org/emacs/ert-expectations.el") + (synopsis "Simple unit test framework for Emacs Lisp") + (description "@code{emacs-ert-expectations} is a simple unit test +framework for Emacs Lisp to be used with @code{ert}.") + (license license:gpl3+))) + +(define-public emacs-deferred + (package + (name "emacs-deferred") + (version "0.5.1") + (home-page "https://github.com/kiwanami/emacs-deferred") + (source (origin + (method git-fetch) + (uri (git-reference + (url home-page) + (commit (string-append "v" version)))) + (sha256 + (base32 + "0xy9zb6wwkgwhcxdnslqk52bq3z24chgk6prqi4ks0qcf2bwyh5h")) + (file-name (string-append name "-" version)))) + (build-system emacs-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-after 'unpack 'set-shell + ;; Setting the SHELL environment variable is required for the tests + ;; to find sh. + (lambda _ + (setenv "SHELL" (which "sh")) + #t)) + (add-before 'check 'fix-makefile + (lambda _ + (substitute* "Makefile" + (("\\$\\(CASK\\) exec ") "")) + #t))) + #:tests? #t + #:test-command '("make" "test"))) + (native-inputs + `(("emacs-ert-expectations" ,emacs-ert-expectations) + ("emacs-undercover" ,emacs-undercover) + ("ert-runner" ,emacs-ert-runner))) + (synopsis "Simple asynchronous functions for Emacs Lisp") + (description + "The @code{deferred.el} library provides support for asynchronous tasks. +The API is almost the same as that of +@uref{https://github.com/cho45/jsdeferred, JSDeferred}, a JavaScript library +for asynchronous tasks.") + (license license:gpl3+))) + +(define-public emacs-butler + (package + (name "emacs-butler") + (version "0.2.4") + (home-page "https://github.com/AshtonKem/Butler") + (source (origin + (method git-fetch) + (uri (git-reference + (url home-page) + (commit version))) + (sha256 + (base32 + "1pii9dw4skq7nr4na6qxqasl36av8cwjp71bf1fgppqpcd9z8skj")) + (file-name (string-append name "-" version)))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-deferred" ,emacs-deferred))) + (synopsis "Emacs client for Jenkins") + (description + "Butler provides an interface to connect to Jenkins continuous +integration servers. Users can specify a list of server in the +@code{butler-server-list} variable and then use @code{M-x butler-status} to +view the build status of those servers' build jobs, and possibly to trigger +build jobs.") + (license license:gpl3+))) + +(define-public emacs-company + (package + (name "emacs-company") + (version "0.9.7") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/company-mode/company-mode/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "19flv38f2qhxda8lbk2ckywvibd72vbzmn4hchqz6d8acsknh4sb")))) + (build-system emacs-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-before 'check 'fix-bin-dir + (lambda _ + ;; The company-files-candidates-normal-root test looks + ;; for the /bin directory, but the build environment has + ;; no /bin directory. Modify the test to look for the + ;; /tmp directory. + (substitute* "test/files-tests.el" + (("/bin/") "/tmp/")) + #t))) + #:tests? #t + #:test-command '("make" "test-batch"))) + (home-page "http://company-mode.github.io/") + (synopsis "Modular text completion framework") + (description + "Company is a modular completion mechanism. Modules for retrieving +completion candidates are called back-ends, modules for displaying them are +front-ends. Company comes with many back-ends, e.g. @code{company-elisp}. +These are distributed in separate files and can be used individually.") + (license license:gpl3+))) + +(define-public emacs-irony-mode + (package + (name "emacs-irony-mode") + (version "1.2.0") + (home-page "https://github.com/Sarcasm/irony-mode") + (source (origin + (method git-fetch) + (uri (git-reference + (url (string-append home-page ".git")) + (commit (string-append "v" version)))) + (sha256 + (base32 + "0nhjrnlmss535jbshjjd30vydbr8py21vkx4p294w6d8vg2rssf8")) + (file-name (string-append name "-" version ".tar.gz")))) + (build-system emacs-build-system) + (inputs `(("server" ,emacs-irony-mode-server))) + (arguments `(#:phases + (modify-phases %standard-phases + (add-after 'unpack 'configure + (lambda* (#:key inputs #:allow-other-keys) + (chmod "irony.el" #o644) + (emacs-substitute-variables "irony.el" + ("irony-server-install-prefix" + (assoc-ref inputs "server"))) + #t))))) + (synopsis "C/C++/ObjC Code completion and syntax checks for Emacs") + (description "Irony-mode provides Clang-assisted syntax checking and +completion for C, C++, and ObjC in GNU Emacs. Using @code{libclang} it can +provide syntax checking and autocompletion on compiler level which is very +resistent against false positives. It also integrates well with other +packages like @code{eldoc-mode} and especially @code{company-mode} as +described on the homepage.") + (license license:gpl3+))) + +(define-public emacs-irony-mode-server + (package (inherit emacs-irony-mode) + (name "emacs-irony-mode-server") + (inputs + `(("clang" ,clang))) + (arguments + `(#:phases + (modify-phases %standard-phases + (replace 'configure + (lambda* (#:key outputs #:allow-other-keys) + (let ((out (assoc-ref outputs "out"))) + (invoke "cmake" + "server" + (string-append "-DCMAKE_INSTALL_PREFIX=" out)) #t)))))) + (build-system cmake-build-system) + (synopsis "Server for the Emacs @dfn{irony mode}"))) + +(define-public emacs-company-irony + (package + (name "emacs-company-irony") + (version "1.1.0") + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/Sarcasm/company-irony.git") + (commit (string-append "v" version)))) + (sha256 (base32 + "1qgyam2vyjw90kpxns5cd6bq3qiqjhzpwrlvmi18vyb69qcgqd8a")) + (file-name (git-file-name name version)))) + (build-system emacs-build-system) + (inputs + `(("emacs-irony-mode" ,emacs-irony-mode) + ("emacs-company" ,emacs-company))) + (synopsis "C++ completion backend for Company using irony-mode") + (description "This backend for company-mode allows for C++ code completion +with irony-mode using clang-tooling.") + (home-page "https://github.com/Sarcasm/company-irony") + (license license:gpl3+))) + +(define-public emacs-flycheck-irony + (package + (name "emacs-flycheck-irony") + (version "0.1.0") + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/Sarcasm/flycheck-irony.git") + (commit (string-append "v" version)))) + (sha256 + (base32 "0qa5a8wzvzxwqql92ibc9s43k8sj3vwn7skz9hfr8av0skkhx996")) + (file-name (string-append name "-" version)))) + (build-system emacs-build-system) + (inputs + `(("irony-mode" ,emacs-irony-mode) + ("flycheck-mode" ,emacs-flycheck) + ("emacs-company" ,emacs-company))) + (synopsis "Live syntax checking frontend for Flycheck using irony-mode") + (description "This package provides a frontend for Flycheck that lets +irony-mode do the syntax checking.") + (home-page "https://github.com/Sarcasm/flycheck-irony") + (license license:gpl3+))) + +(define-public emacs-irony-eldoc + (package + (name "emacs-irony-eldoc") + (version (package-version emacs-irony-mode)) + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/ikirill/irony-eldoc.git") + (commit "0df5831eaae264a25422b061eb2792aadde8b3f2"))) + (sha256 (base32 "1l5qpr66v1l12fb50yh73grb2rr85xxmbj19mm33b5rdrq2bqmmd")) + (file-name (string-append name "-" version)))) + (build-system emacs-build-system) + (inputs + `(("irony-mode" ,emacs-irony-mode))) + (synopsis "Eldoc integration for irony-mode") + (description "Irony-eldoc is an eldoc extension that shows documentation +for the current function or variable in the minibuffer.") + (home-page "https://github.com/ikirill/irony-eldoc") + (license license:gpl3+))) + +(define-public emacs-company-quickhelp + (package + (name "emacs-company-quickhelp") + (version "2.3.0") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/expez/company-quickhelp/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0xrn2z1dgk5gmkmp2jkn9g83ckk39lqp5pyyv8rl7f6gqvib3qh0")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-pos-tip" ,emacs-pos-tip) + ("emacs-company" ,emacs-company))) + (home-page "https://github.com/expez/company-quickhelp") + (synopsis "Popup documentation for completion candidates") + (description "@code{company-quickhelp} shows documentation for the +completion candidate when using the Company text completion framework.") + (license license:gpl3+))) + +(define-public emacs-multiple-cursors + (package + (name "emacs-multiple-cursors") + (version "1.4.0") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/magnars/multiple-cursors.el/" + "archive/" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0hihihlvcvzayg5fnqzcg45fhvlmq6xlq58syy00rjwbry9w389k")))) + (build-system emacs-build-system) + (home-page "https://github.com/magnars/multiple-cursors.el") + (synopsis "Multiple cursors for Emacs") + (description + "This package adds support to Emacs for editing text with multiple +simultaneous cursors.") + (license license:gpl3+))) + +(define-public emacs-typo + (package + (name "emacs-typo") + (version "1.1") + (home-page "https://github.com/jorgenschaefer/typoel") + (source (origin + (method git-fetch) + (uri (git-reference + (url home-page) + (commit (string-append "v" version)))) + (sha256 + (base32 + "1jhd4grch5iz12gyxwfbsgh4dmz5hj4bg4gnvphccg8dsnni05k2")) + (file-name (string-append name "-" version)))) + (build-system emacs-build-system) + (synopsis "Minor mode for typographic editing") + (description + "This package provides two Emacs modes, @code{typo-mode} and +@code{typo-global-mode}. These modes automatically insert Unicode characters +for quotation marks, dashes, and ellipses. For example, typing @kbd{\"} +automatically inserts a Unicode opening or closing quotation mark, depending +on context.") + (license license:gpl3+))) + +(define-public emacs-scheme-complete + (let ((commit "9b5cf224bf2a5994bc6d5b152ff487517f1a9bb5")) + (package + (name "emacs-scheme-complete") + (version (string-append "20151223." (string-take commit 8))) + (source + (origin + (file-name (string-append name "-" version)) + (method git-fetch) + (uri (git-reference + (url "https://github.com/ashinn/scheme-complete.git") + (commit commit))) + (sha256 + (base32 + "141wn9l0m33w0g3dqmx8nxbfdny1r5xbr6ak61rsz21bk0qafs7x")) + (patches + (search-patches "emacs-scheme-complete-scheme-r5rs-info.patch")))) + (build-system emacs-build-system) + (home-page "https://github.com/ashinn/scheme-complete") + (synopsis "Smart tab completion for Scheme in Emacs") + (description + "This file provides a single function, @code{scheme-smart-complete}, +which you can use for intelligent, context-sensitive completion for any Scheme +implementation in Emacs. To use it just load this file and bind that function +to a key in your preferred mode.") + (license license:public-domain)))) + +(define-public emacs-scel + (let ((version "20170629") + (revision "1") + (commit "aeea3ad4be9306d14c3a734a4ff54fee10ac135b")) + (package + (name "emacs-scel") + (version (git-version version revision commit)) + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/supercollider/scel.git") + (commit commit))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "0jvmzs1lsjyndqshhii2y4mnr3wghai26i3p75453zrpxpg0zvvw")))) + (build-system emacs-build-system) + (arguments + `(#:modules ((guix build emacs-build-system) + ((guix build cmake-build-system) #:prefix cmake:) + (guix build utils)) + #:imported-modules (,@%emacs-build-system-modules + (guix build cmake-build-system)) + #:phases + (modify-phases %standard-phases + (add-after 'unpack 'configure + (lambda* (#:key outputs #:allow-other-keys) + (substitute* "el/CMakeLists.txt" + (("share/emacs/site-lisp/SuperCollider") + (string-append + "share/emacs/site-lisp/guix.d/scel-" ,version))) + ((assoc-ref cmake:%standard-phases 'configure) + #:outputs outputs + #:configure-flags '("-DSC_EL_BYTECOMPILE=OFF")))) + (add-after 'set-emacs-load-path 'add-el-dir-to-emacs-load-path + (lambda _ + (setenv "EMACSLOADPATH" + (string-append (getcwd) "/el:" (getenv "EMACSLOADPATH"))) + #t)) + (replace 'install (assoc-ref cmake:%standard-phases 'install))))) + (inputs + `(("supercollider" ,supercollider))) + (native-inputs + `(("cmake" ,cmake))) + (home-page "https://github.com/supercollider/scel") + (synopsis "SuperCollider Emacs interface") + (description "@code{emacs-scel} is an Emacs interface to SuperCollider. +SuperCollider is a platform for audio synthesis and algorithmic composition.") + (license license:gpl2+)))) + +(define-public emacs-mit-scheme-doc + (package + (name "emacs-mit-scheme-doc") + (version "20140203") + (source + (origin + (modules '((guix build utils))) + (snippet + ;; keep only file of interest + '(begin + (for-each delete-file '("dot-emacs.el" "Makefile")) + (install-file "6.945-config/mit-scheme-doc.el" ".") + (delete-file-recursively "6.945-config") + #t)) + (file-name (string-append name "-" version ".tar.bz2")) + (method url-fetch) + (uri (string-append "http://groups.csail.mit.edu/mac/users/gjs/" + "6.945/dont-panic/emacs-basic-config.tar.bz2")) + (sha256 + (base32 + "0dqidg2bd66pawqfarvwca93w5gqf9mikn1k2a2rmd9ymfjpziq1")))) + (build-system emacs-build-system) + (inputs `(("mit-scheme" ,mit-scheme))) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-after 'unpack 'configure-doc + (lambda* (#:key inputs #:allow-other-keys) + (let* ((mit-scheme-dir (assoc-ref inputs "mit-scheme")) + (doc-dir (string-append mit-scheme-dir "/share/doc/" + "mit-scheme-" + ,(package-version mit-scheme)))) + (substitute* "mit-scheme-doc.el" + (("http://www\\.gnu\\.org/software/mit-scheme/documentation/mit-scheme-ref/") + (string-append "file:" doc-dir "/mit-scheme-ref/"))))))))) + (home-page "http://groups.csail.mit.edu/mac/users/gjs/6.945/dont-panic/") + (synopsis "MIT-Scheme documentation lookup for Emacs") + (description + "This package provides a set of Emacs functions to search definitions of +identifiers in the MIT-Scheme documentation.") + (license license:gpl2+))) + +(define-public emacs-constants + (package + (name "emacs-constants") + (version "2.6") + (home-page "https://staff.fnwi.uva.nl/c.dominik/Tools/constants") + (source + (origin + (file-name (string-append name "-" version ".tar.gz")) + (method url-fetch) + (uri (string-append "https://github.com/fedeinthemix/emacs-constants" + "/archive/v" version ".tar.gz")) + (sha256 + (base32 + "0pnrpmmxq8mh5h2hbrp5vcym0j0fh6dv3s7c5ccn18wllhzg9g7n")))) + (build-system emacs-build-system) + (synopsis "Enter definition of constants into an Emacs buffer") + (description + "This package provides functions for inserting the definition of natural +constants and units into an Emacs buffer.") + (license license:gpl2+))) + +(define-public emacs-tagedit + (package + (name "emacs-tagedit") + (version "1.4.0") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/magnars/tagedit/" + "archive/" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1apfnann4qklfdsmdi7icjsj18x7gwx8d83iqr4z25clszz95xfq")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-s" ,emacs-s) + ("emacs-dash" ,emacs-dash))) + (home-page "https://github.com/magnars/tagedit") + (synopsis "Some paredit-like features for html-mode") + (description + "This package provides a collection of paredit-like functions for editing +in @code{html-mode}.") + (license license:gpl3+))) + +(define-public emacs-slime + (package + (name "emacs-slime") + (version "2.22") + (source + (origin + (file-name (string-append name "-" version ".tar.gz")) + (method url-fetch) + (uri (string-append + "https://github.com/slime/slime/archive/v" + version ".tar.gz")) + (sha256 + (base32 + "07vaib1n4zyh5yy30gdpq0bc5cv6w84piml5b3mfc9ibjhaykkms")))) + (build-system emacs-build-system) + (native-inputs + `(("texinfo" ,texinfo))) + (arguments + `(#:include '("\\.el$" "\\.lisp$" "\\.asd$" "contrib") + #:exclude '("^slime-tests.el" "^contrib/test/" + "^contrib/Makefile$" "^contrib/README.md$") + #:phases + (modify-phases %standard-phases + (add-before 'install 'configure + (lambda* _ + (emacs-substitute-variables "slime.el" + ("inferior-lisp-program" "sbcl")) + #t)) + (add-before 'install 'install-doc + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (info-dir (string-append out "/share/info")) + (doc-dir (string-append out "/share/doc/" + ,name "-" ,version)) + (doc-files '("doc/slime-refcard.pdf" + "README.md" "NEWS" "PROBLEMS" + "CONTRIBUTING.md"))) + (with-directory-excursion "doc" + (substitute* "Makefile" + (("infodir=/usr/local/info") + (string-append "infodir=" info-dir))) + (invoke "make" "html/index.html") + (invoke "make" "slime.info") + (install-file "slime.info" info-dir) + (copy-recursively "html" (string-append doc-dir "/html"))) + (for-each (lambda (f) + (install-file f doc-dir) + (delete-file f)) + doc-files) + (delete-file-recursively "doc") + #t)))))) + (home-page "https://github.com/slime/slime") + (synopsis "Superior Lisp Interaction Mode for Emacs") + (description + "SLIME extends Emacs with support for interactive programming in +Common Lisp. The features are centered around @command{slime-mode}, +an Emacs minor mode that complements the standard @command{lisp-mode}. +While lisp-mode supports editing Lisp source files, @command{slime-mode} +adds support for interacting with a running Common Lisp process +for compilation, debugging, documentation lookup, and so on.") + (license (list license:gpl2+ license:public-domain)))) + +(define-public emacs-popup + (package + (name "emacs-popup") + (version "0.5.3") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/auto-complete/popup-el/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1yrgfj8y69xmcb6kwgplhq68ndm9410qwh7sd2knnd1gchpphdc0")))) + (build-system emacs-build-system) + (home-page "https://github.com/auto-complete/popup-el") + (synopsis "Visual Popup User Interface for Emacs") + (description + "Popup.el is a visual popup user interface library for Emacs. +This provides a basic API and common UI widgets such as popup tooltips +and popup menus.") + (license license:gpl3+))) + +(define-public emacs-puppet-mode + (let ((commit "b3ed5057166a4f49dfa9be638523a348b55a2fd2") + (revision "1")) + (package + (name "emacs-puppet-mode") + ;; The last release, 0.3 was several years ago, and there have been many + ;; commits since + (version (git-version "0.3" revision commit)) + (source + (origin + (method url-fetch) + (uri (string-append + "https://raw.githubusercontent.com/voxpupuli/puppet-mode/" + commit "/puppet-mode.el")) + (sha256 + (base32 + "1indycxawsl0p2aqqg754f6735q3cmah9vd886rpn0ncc3ipi1xm")))) + (build-system emacs-build-system) + (home-page "https://github.com/voxpupuli/puppet-mode") + (synopsis "Emacs major mode for the Puppet configuration language") + (description + "This package provides support for the Puppet configuration language, +including syntax highlighting, indentation of expressions and statements, +linting of manifests and integration with Puppet Debugger.") + ;; Also incorporates work covered by the Apache License, Version 2.0 + (license license:gpl3+)))) + +(define-public emacs-god-mode + (let ((commit "6cf0807b6555eb6fcf8387a4e3b667071ef38964") + (revision "1")) + (package + (name "emacs-god-mode") + (version (string-append "20151005.925." + revision "-" (string-take commit 9))) + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/chrisdone/god-mode.git") + (commit commit))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "1am415k4xxcva6y3vbvyvknzc6bma49pq3p85zmpjsdmsp18qdix")))) + (build-system emacs-build-system) + (home-page "https://github.com/chrisdone/god-mode") + (synopsis "Minor mode for entering commands without modifier keys") + (description + "This package provides a global minor mode for entering Emacs commands +without modifier keys. It's similar to Vim's separation of commands and +insertion mode. When enabled all keys are implicitly prefixed with +@samp{C-} (among other helpful shortcuts).") + (license license:gpl3+)))) + +(define-public emacs-jinja2-mode + (package + (name "emacs-jinja2-mode") + (version "0.2") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/paradoxxxzero/jinja2-mode/" + "archive/v" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0cgxjab1kla2zc2fj7bzib6i7snp08zshandmp9kqcm85l262xpn")))) + (build-system emacs-build-system) + (home-page "https://github.com/paradoxxxzero/jinja2-mode") + (synopsis "Major mode for jinja2") + (description + "Emacs major mode for jinja2 with: syntax highlighting, +sgml/html integration, and indentation (working with sgml).") + (license license:gpl3+))) + +(define-public emacs-rfcview + (package + (name "emacs-rfcview") + (version "0.13") + (home-page "http://www.loveshack.ukfsn.org/emacs") + (source (origin + (method url-fetch) + (uri "http://www.loveshack.ukfsn.org/emacs/rfcview.el") + (sha256 + (base32 + "0ympj5rxig383zl2jf0pzdsa80nnq0dpvjiriq0ivfi98fj7kxbz")))) + (build-system emacs-build-system) + (synopsis "Prettify Request for Comments (RFC) documents") + (description "The Internet Engineering Task Force (IETF) and the Internet +Society (ISOC) publish various Internet-related protocols and specifications +as \"Request for Comments\" (RFC) documents and Internet Standard (STD) +documents. RFCs and STDs are published in a simple text form. This package +provides an Emacs major mode, rfcview-mode, which makes it more pleasant to +read these documents in Emacs. It prettifies the text and adds +hyperlinks/menus for easier navigation. It also provides functions for +browsing the index of RFC documents and fetching them from remote servers or +local directories.") + (license license:gpl3+))) + +(define-public emacs-ffap-rfc-space + (package + (name "emacs-ffap-rfc-space") + (version "12") + (home-page "http://user42.tuxfamily.org/ffap-rfc-space/index.html") + (source (origin + (method url-fetch) + (uri "http://download.tuxfamily.org/user42/ffap-rfc-space.el") + (sha256 + (base32 + "1iv61dv57a73mdps7rn6zmgz7nqh14v0ninidyrasy45b1nv6gck")))) + (build-system emacs-build-system) + (synopsis "Make ffap recognize an RFC with a space before its number") + (description "The Internet Engineering Task Force (IETF) and the +Internet Society (ISOC) publish various Internet-related protocols and +specifications as \"Request for Comments\" (RFC) documents. The +built-in Emacs module \"ffap\" (Find File at Point) has the ability to +recognize names at point which look like \"RFC1234\" and \"RFC-1234\" +and load the appropriate RFC from a remote server. However, it fails +to recognize a name like \"RFC 1234\". This package enhances ffap so +that it correctly finds RFCs even when a space appears before the +number.") + (license license:gpl3+))) + +(define-public emacs-org-bullets + (package + (name "emacs-org-bullets") + (version "0.2.4") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/sabof/org-bullets/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1dyxvpb73vj80v8br2q9rf255hfphrgaw91fbvwdcd735np9pcnh")))) + (build-system emacs-build-system) + (home-page "https://github.com/sabof/org-bullets") + (synopsis "Show bullets in org-mode as UTF-8 characters") + (description + "This package provides an Emacs minor mode causing bullets in +@code{org-mode} to be rendered as UTF-8 characters.") + (license license:gpl3+))) + +(define-public emacs-org-pomodoro + (package + (name "emacs-org-pomodoro") + (version "2.1.0") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/lolownia/org-pomodoro/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1jalsggw3q5kvj353f84x4nl04a5vmq07h75ggppy1627lb31zm4")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-alert" ,emacs-alert))) + (home-page "https://github.com/lolownia/org-pomodoro") + (synopsis "Pomodoro technique for org-mode") + (description "@code{emacs-org-pomodoro} adds very basic support for +Pomodoro technique in Emacs org-mode. + +Run @code{M-x org-pomodoro} for the task at point or select one of the +last tasks that you clocked time for. Each clocked-in pomodoro starts +a timer of 25 minutes and after each pomodoro a break timer of 5 +minutes is started automatically. Every 4 breaks a long break is +started with 20 minutes. All values are customizable.") + (license license:gpl3+))) + +(define-public emacs-org-trello + (package + (name "emacs-org-trello") + (version "0.8.0") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/org-trello/org-trello/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0549mnf5cgwn8b8jbl38fljbaxmh1605sv9j8f3lsa95jhs1zpa0")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-dash" ,emacs-dash) + ("emacs-deferred" ,emacs-deferred) + ("emacs-f" ,emacs-f) + ("emacs-helm" ,emacs-helm) + ("emacs-request" ,emacs-request) + ("emacs-s" ,emacs-s))) + (home-page "https://org-trello.github.io") + (synopsis "Emacs minor mode for interacting with Trello") + (description "This package provides an Emacs minor mode to extend +@code{org-mode} with Trello abilities. Trello is an online project +organizer.") + (license license:gpl3+))) + +(define-public emacs-atom-one-dark-theme + (let ((commit "1f1185bf667a38d3d0d180ce85fd4c131818aae2") + (revision "0")) + (package + (name "emacs-atom-one-dark-theme") + (version (git-version "0.4.0" revision commit)) + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/jonathanchu/atom-one-dark-theme.git") + (commit commit))) + (sha256 + (base32 + "1alma16hg3mfjly8a9s3mrswkjjx4lrpdnf43869hn2ibkn7zx9z")) + (file-name (git-file-name name version)))) + (build-system emacs-build-system) + (home-page "https://github.com/jonathanchu/atom-one-dark-theme") + (synopsis "Atom One Dark color theme for Emacs") + (description "An Emacs port of the Atom One Dark theme from Atom.io.") + (license license:gpl3+)))) + +(define-public emacs-zenburn-theme + (package + (name "emacs-zenburn-theme") + (version "2.6") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/bbatsov/zenburn-emacs/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0qc9d1rwq55yzh8shbppyd6izy1grpyr8kqh5zdgm7c5jccngpr4")))) + (build-system emacs-build-system) + (home-page "https://github.com/bbatsov/zenburn-emacs") + (synopsis "Low contrast color theme for Emacs") + (description + "Zenburn theme is a port of the popular Vim Zenburn theme for Emacs. +It is built on top of the custom theme support in Emacs 24 or later.") + (license license:gpl3+))) + +(define-public emacs-solarized-theme + (package + (name "emacs-solarized-theme") + (version "1.2.2") + (source (origin + (method url-fetch) + (uri (string-append "https://github.com/bbatsov/solarized-emacs/" + "archive/v" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1ha3slc6d9wi9ilkhmwrzkvf308n6ph7b0k69pk369s9304awxzx")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-dash" ,emacs-dash))) + (home-page "https://github.com/bbatsov/solarized-emacs") + (synopsis "Port of the Solarized theme for Emacs") + (description + "Solarized for Emacs is a port of the Solarized theme for Vim. This +package provides a light and a dark variant.") + (license license:gpl3+))) + +(define-public emacs-ahungry-theme + (package + (name "emacs-ahungry-theme") + (version "1.10.0") + (source + (origin (method url-fetch) + (uri (string-append "https://elpa.gnu.org/packages/ahungry-theme-" + version ".tar")) + (sha256 + (base32 + "14q5yw56n82qph09bk7wmj5b1snhh9w0nk5s1l7yn9ldg71xq6pm")))) + (build-system emacs-build-system) + (home-page "https://github.com/ahungry/color-theme-ahungry") + (synopsis "Ahungry color theme for Emacs") + (description "Ahungry theme for Emacs provides bright and bold colors. +If you load it from a terminal, you will be able to make use of the +transparent background. If you load it from a GUI, it will default to a +dark background.") + (license license:gpl3+))) + +(define-public emacs-2048-game + (package + (name "emacs-2048-game") + (version "20151026.1233") + (source + (origin + (method url-fetch) + (uri (string-append "https://melpa.org/packages/2048-game-" + version ".el")) + (sha256 + (base32 + "0gy2pvz79whpavp4jmz8h9krzn7brmvv3diixi1d4w51pcdvaldd")))) + (build-system emacs-build-system) + (home-page "https://bitbucket.org/zck/2048.el") + (synopsis "Implementation of the game 2048 in Emacs Lisp") + (description + "This program is an implementation of 2048 for Emacs. +The goal of this game is to create a tile with value 2048. The size of the +board and goal value can be customized.") + (license license:gpl3+))) + +(define-public emacs-base16-theme + (package + (name "emacs-base16-theme") + (version "2.1") + (source + (origin + (method url-fetch) + (uri (string-append "https://stable.melpa.org/packages/base16-theme-" + version ".tar")) + (sha256 + (base32 + "0z6hrwz2jlz6jbr381rcqcqvx6hss5cad352klx07rark7zccacj")))) + (build-system emacs-build-system) + (home-page "https://github.com/belak/base16-emacs") + (synopsis "Base16 color themes for Emacs") + (description + "Base16 provides carefully chosen syntax highlighting and a default set +of sixteen colors suitable for a wide range of applications. Base16 is not a +single theme but a set of guidelines with numerous implementations.") + (license license:expat))) + +(define-public emacs-smartparens + (package + (name "emacs-smartparens") + (version "1.11.0") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/Fuco1/smartparens/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0q5as813xs8y29i3v2rm97phd6m7xsmmw6hwbvx57gwmi8i1c409")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-dash" ,emacs-dash) + ("emacs-markdown-mode" ,emacs-markdown-mode))) + (home-page "https://github.com/Fuco1/smartparens") + (synopsis "Paredit-like insertion, wrapping and navigation with user +defined pairs") + (description + "Smartparens is a minor mode for Emacs that deals with parens pairs +and tries to be smart about it. It started as a unification effort to +combine functionality of several existing packages in a single, +compatible and extensible way to deal with parentheses, delimiters, tags +and the like. Some of these packages include autopair, textmate, +wrap-region, electric-pair-mode, paredit and others. With the basic +features found in other packages it also brings many improvements as +well as completely new features.") + (license license:gpl3+))) + +(define-public emacs-highlight-symbol + (package + (name "emacs-highlight-symbol") + (version "1.3") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/nschum/highlight-symbol.el/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1n7k1qns0fn0jsyc0hrjac5nzk21xw48yc30vyrhwvc51h0b9g90")))) + (build-system emacs-build-system) + (home-page "https://nschum.de/src/emacs/highlight-symbol") + (synopsis "Automatic and manual symbol highlighting for Emacs") + (description + "Use @code{highlight-symbol} to toggle highlighting of the symbol at +point throughout the current buffer. Use @code{highlight-symbol-mode} to keep +the symbol at point highlighted. + +The functions @code{highlight-symbol-next}, @code{highlight-symbol-prev}, +@code{highlight-symbol-next-in-defun} and +@code{highlight-symbol-prev-in-defun} allow for cycling through the locations +of any symbol at point. Use @code{highlight-symbol-nav-mode} to enable key +bindings @code{M-p} and @code{M-p} for navigation. When +@code{highlight-symbol-on-navigation-p} is set, highlighting is triggered +regardless of @code{highlight-symbol-idle-delay}. + +@code{highlight-symbol-query-replace} can be used to replace the symbol. ") + (license license:gpl2+))) + +(define-public emacs-hl-todo + (package + (name "emacs-hl-todo") + (version "1.9.0") + (source (origin + (method url-fetch) + (uri (string-append + "https://raw.githubusercontent.com/tarsius/hl-todo/" + version "/hl-todo.el")) + (file-name (string-append "hl-todo-" version ".el")) + (sha256 + (base32 + "0728givzh7xv5i88ac9if8byj1p8bilrj1fnizca10s0rv100hdr")))) + (build-system emacs-build-system) + (home-page "https://github.com/tarsius/hl-todo") + (synopsis "Emacs mode to highlight TODO and similar keywords") + (description + "This package provides an Emacs mode to highlight TODO and similar +keywords in comments and strings. This package also provides commands for +moving to the next or previous keyword and to invoke @code{occur} with a +regexp that matches all known keywords.") + (license license:gpl3+))) + +(define-public emacs-perspective + (package + (name "emacs-perspective") + (version "1.12") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/nex3/perspective-el/" + "archive/" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "078ahh0kmhdylq5ib9c81c76kz1n02xwc83pm729d00i84ibviic")))) + (build-system emacs-build-system) + (home-page "https://github.com/nex3/perspective-el") + (synopsis "Switch between named \"perspectives\"") + (description + "This package provides tagged workspaces in Emacs, similar to workspaces in +windows managers such as Awesome and XMonad. @code{perspective.el} provides +multiple workspaces (or \"perspectives\") for each Emacs frame. Each +perspective is composed of a window configuration and a set of buffers. +Switching to a perspective activates its window configuration, and when in a +perspective only its buffers are available by default.") + ;; This package is released under the same license as Emacs (GPLv3+) or + ;; the Expat license. + (license license:gpl3+))) + +(define-public emacs-test-simple + (package + (name "emacs-test-simple") + (version "1.3.0") + (source + (origin + (method url-fetch) + (uri (string-append "https://elpa.gnu.org/packages/test-simple-" + version ".el")) + (sha256 + (base32 + "1yd61jc9ds95a5n09052kwc5gasy57g4lxr0jsff040brlyi9czz")))) + (build-system emacs-build-system) + (home-page "https://github.com/rocky/emacs-test-simple") + (synopsis "Simple unit test framework for Emacs Lisp") + (description + "Test Simple is a simple unit test framework for Emacs Lisp. It +alleviates the need for context macros, enclosing specifications or required +test tags. It supports both interactive and non-interactive use.") + (license license:gpl3+))) + +(define-public emacs-load-relative + (package + (name "emacs-load-relative") + (version "1.3") + (source + (origin + (method url-fetch) + (uri (string-append "https://elpa.gnu.org/packages/load-relative-" + version ".el")) + (sha256 + (base32 + "1hfxb2436jdsi9wfmsv47lkkpa5galjf5q81bqabbsv79rv59dps")))) + (build-system emacs-build-system) + (home-page "http://github.com/rocky/emacs-load-relative") + (synopsis "Emacs Lisp relative file loading related functions") + (description + "Provides functions which facilitate writing multi-file Emacs packages +and running from the source tree without having to \"install\" code or fiddle +with @{load-path}. + +The main function, @code{load-relative}, loads an Emacs Lisp file relative to +another (presumably currently running) Emacs Lisp file.") + (license license:gpl3+))) + +(define-public emacs-loc-changes + (package + (name "emacs-loc-changes") + (version "1.2") + (source + (origin + (method url-fetch) + (uri (string-append "https://elpa.gnu.org/packages/loc-changes-" + version ".el")) + (sha256 + (base32 + "1x8fn8vqasayf1rb8a6nma9n6nbvkx60krmiahyb05vl5rrsw6r3")))) + (build-system emacs-build-system) + (home-page "https://github.com/rocky/emacs-loc-changes") + (synopsis "Keeps track of positions even after buffer changes") + (description + "This Emacs package provides a mean to track important buffer positions +after buffer changes.") + (license license:gpl3+))) + +(define-public emacs-realgud + (package + (name "emacs-realgud") + (version "1.4.5") + (source + (origin + (method url-fetch) + (uri (string-append "https://elpa.gnu.org/packages/realgud-" + version ".tar")) + (sha256 + (base32 + "108wgxg7fb4byaiasgvbxv2hq7b00biq9f0mh9hy6vw4160y5w24")) + (patches + ;; Patch awaiting inclusion upstream (see: + ;; https://github.com/realgud/realgud/pull/226). + (search-patches "emacs-realgud-fix-configure-ac.patch")))) + (build-system emacs-build-system) + (arguments + `(#:tests? #t + #:phases + (modify-phases %standard-phases + (add-after 'set-emacs-load-path 'fix-autogen-script + (lambda _ + (substitute* "autogen.sh" + (("./configure") "sh configure")))) + (add-after 'fix-autogen-script 'autogen + (lambda _ + (setenv "CONFIG_SHELL" "sh") + (invoke "sh" "autogen.sh"))) + (add-after 'fix-autogen-script 'set-home + (lambda _ + (setenv "HOME" (getenv "TMPDIR")))) + (add-before 'patch-el-files 'remove-realgud-pkg.el + (lambda _ + ;; XXX: This file is auto-generated at some point and causes + ;; substitute* to crash during the `patch-el-files' phase with: + ;; ERROR: In procedure stat: No such file or directory: + ;; "./realgud-pkg.el" + (delete-file "./realgud-pkg.el") + ;; FIXME: `patch-el-files' crashes on this file with error: + ;; unable to locate "bashdb". + (delete-file "./test/test-regexp-bashdb.el")))) + #:include (cons* ".*\\.el$" %default-include))) + (native-inputs + `(("autoconf" ,autoconf) + ("automake" ,automake) + ("emacs-test-simple" ,emacs-test-simple))) + (propagated-inputs + `(("emacs-load-relative" ,emacs-load-relative) + ("emacs-loc-changes" ,emacs-loc-changes))) + (home-page "https://github.com/realgud/realgud/") + (synopsis + "Modular front-end for interacting with external debuggers") + (description + "RealGUD is a modular, extensible GNU Emacs front-end for interacting +with external debuggers. It integrates various debuggers such as gdb, pdb, +ipdb, jdb, lldb, bashdb, zshdb, etc. and allows to visually step code in the +sources. Unlike GUD, it also supports running multiple debug sessions in +parallel.") + (license license:gpl3+))) + +(define-public emacs-request + (package + (name "emacs-request") + (version "0.3.0") + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/tkf/emacs-request.git") + (commit (string-append "v" version)))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "0wyxqbb35yqf6ci47531lk32d6fppamx9d8826kdz983vm87him7")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-deferred" ,emacs-deferred))) + (home-page "https://github.com/tkf/emacs-request") + (synopsis "Package for speaking HTTP in Emacs Lisp") + (description "This package provides a HTTP request library with multiple +backends. It supports url.el which is shipped with Emacs and the curl command +line program.") + (license license:gpl3+))) + +(define-public emacs-rudel + (package + (name "emacs-rudel") + (version "0.3.1") + (source + (origin + (method url-fetch) + (uri (string-append "http://elpa.gnu.org/packages/rudel-" + version ".tar")) + (sha256 + (base32 + "0glqa68g509p0s2vcc0i8kzlddnc9brd9jqhnm5rzxz4i050cvnz")))) + (build-system emacs-build-system) + (home-page "http://rudel.sourceforge.net/") + (synopsis "Collaborative editing framework") + (description + "Rudel is a collaborative editing environment for GNU Emacs. Its purpose +is to share buffers with other users in order to edit the contents of those +buffers collaboratively. Rudel supports multiple backends to enable +communication with other collaborative editors using different protocols, +though currently Obby (for use with the Gobby editor) is the only +fully-functional one.") + (license license:gpl3+))) + +(define-public emacs-hydra + (package + (name "emacs-hydra") + (version "0.14.0") + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/abo-abo/hydra") + (commit version))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "0ln4z2796ycy33g5jcxkqvm7638qxy4sipsab7d2864hh700cikg")))) + (build-system emacs-build-system) + (home-page "https://github.com/abo-abo/hydra") + (synopsis "Make Emacs bindings that stick around") + (description + "This package can be used to tie related commands into a family of short +bindings with a common prefix---a Hydra. Once you summon the Hydra (through +the prefixed binding), all the heads can be called in succession with only a +short extension. Any binding that isn't the Hydra's head vanquishes the +Hydra. Note that the final binding, besides vanquishing the Hydra, will still +serve its original purpose, calling the command assigned to it. This makes +the Hydra very seamless; it's like a minor mode that disables itself +automatically.") + (license license:gpl3+))) + +(define-public emacs-ivy + (package + (name "emacs-ivy") + (version "0.10.0") + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/abo-abo/swiper.git") + (commit version))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "14vnigqb5c3yi4q9ysw1fiwdqyqwyklqpb9wnjf81chm7s2mshnr")))) + (build-system emacs-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-after 'install 'install-doc + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (info (string-append out "/share/info"))) + (with-directory-excursion "doc" + (invoke "makeinfo" "ivy.texi") + (install-file "ivy.info" info) + #t))))))) + (propagated-inputs + `(("emacs-hydra" ,emacs-hydra))) + (native-inputs + `(("texinfo" ,texinfo))) + (home-page "http://oremacs.com/swiper/") + (synopsis "Incremental vertical completion for Emacs") + (description + "This package provides @code{ivy-read} as an alternative to +@code{completing-read} and similar functions. No attempt is made to determine +the best candidate. Instead, the user can navigate candidates with +@code{ivy-next-line} and @code{ivy-previous-line}. The matching is done by +splitting the input text by spaces and re-building it into a regular +expression.") + (license license:gpl3+))) + +(define-public emacs-ivy-yasnippet + (let ((commit "32580b4fd23ebf9ca7dde96704f7d53df6e253cd") + (revision "2")) + (package + (name "emacs-ivy-yasnippet") + (version (git-version "0.1" revision commit)) + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/mkcms/ivy-yasnippet.git") + (commit commit))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "1wfg6mmd5gl1qgvayyzpxlkh9s7jgn20y8l1vh1zbj1czvv51xp8")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-ivy" ,emacs-ivy) + ("emacs-yasnippet" ,emacs-yasnippet) + ("emacs-dash" ,emacs-dash))) + (home-page "https://github.com/mkcms/ivy-yasnippet") + (synopsis "Preview @code{yasnippets} with @code{ivy}") + (description "This package allows you to select @code{yasnippet} +snippets using @code{ivy} completion. When current selection changes in the +minibuffer, the snippet contents are temporarily expanded in the buffer. To +use it, call @code{M-x ivy-yasnippet} (but make sure you have enabled +@code{yas-minor-mode} first).") + (license license:gpl3+)))) + +(define-public emacs-ivy-rich + (package + (name "emacs-ivy-rich") + (version "0.1.0") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/Yevgnen/ivy-rich/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "14r3mx5rkd4wz0ls5pv5w6c7la3z9iy93d3jfind3xyg4kywy95c")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-ivy" ,emacs-ivy))) + (home-page "https://github.com/Yevgnen/ivy-rich") + (synopsis "More friendly interface for @code{ivy}") + (description + "This package extends @code{ivy} by showing more information in the +minibuffer for each candidate. It adds columns showing buffer modes, file +sizes, docstrings, etc. If @code{emacs-all-the-icons} is installed, it can +show icons as well.") + (license license:gpl3+))) + +(define-public emacs-avy + (package + (name "emacs-avy") + (version "0.4.0") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/abo-abo/avy/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1wdrq512h25ymzjbf2kbsdymvd2ryfwzb6bh5bc3yv7q203im796")))) + (build-system emacs-build-system) + (home-page "https://github.com/abo-abo/avy") + (synopsis "Tree-based completion for Emacs") + (description + "This package provides a generic completion method based on building a +balanced decision tree with each candidate being a leaf. To traverse the tree +from the root to a desired leaf, typically a sequence of @code{read-key} can +be used. + +In order for @code{read-key} to make sense, the tree needs to be visualized +appropriately, with a character at each branch node. So this completion +method works only for things that you can see on your screen, all at once, +such as the positions of characters, words, line beginnings, links, or +windows.") + (license license:gpl3+))) + +(define-public emacs-ace-window + (package + (name "emacs-ace-window") + (version "0.9.0") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/abo-abo/ace-window/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1p2sgfl5dml4zbd6ldql6lm2m9vmd236ah996ni32x254s48j5pn")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-avy" ,emacs-avy))) + (home-page "https://github.com/abo-abo/ace-window") + (synopsis "Quickly switch windows in Emacs") + (description + "@code{ace-window} is meant to replace @code{other-window}. +In fact, when there are only two windows present, @code{other-window} is +called. If there are more, each window will have its first character +highlighted. Pressing that character will switch to that window.") + (license license:gpl3+))) + +(define-public emacs-iedit + (package + (name "emacs-iedit") + (version "0.9.9.9") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/victorhge/iedit/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1hv8q6pr85ss9g3158l1fqv3m62vsq8rslsi86jicr2dcxyascr0")))) + (build-system emacs-build-system) + (home-page "http://www.emacswiki.org/emacs/Iedit") + (synopsis "Edit multiple regions in the same way simultaneously") + (description + "This package is an Emacs minor mode and allows you to edit one +occurrence of some text in a buffer (possibly narrowed) or region, and +simultaneously have other occurrences edited in the same way. + +You can also use Iedit mode as a quick way to temporarily show only the buffer +lines that match the current text being edited. This gives you the effect of +a temporary @code{keep-lines} or @code{occur}.") + (license license:gpl3+))) + +(define-public emacs-zoutline + (let ((commit "b3ee0f0e0b916838c2d2c249beba74ffdb8d5699") + (revision "0")) + (package + (name "emacs-zoutline") + (version (git-version "0.1" revision commit)) + (home-page "https://github.com/abo-abo/zoutline") + (source (origin + (method git-fetch) + (uri (git-reference (url home-page) (commit commit))) + (sha256 + (base32 + "0sd0017piw0dis6dhpq5dkqd3acisxqgipl7dj8gmc1vnswhdwr8")) + (file-name (git-file-name name version)))) + (build-system emacs-build-system) + (synopsis "Simple outline library") + (description + "This library provides helpers for outlines. Outlines allow users to +navigate code in a tree-like fashion.") + (license license:gpl3+)))) + +(define-public emacs-lispy + ;; Release 0.26.0 was almost 3 years ago, and there have been ~772 commits + ;; since. + (let ((commit "c2a358a7a15fcf056a5b7461a8e690b481b03b80") + (revision "0")) + (package + (name "emacs-lispy") + (version (git-version "0.26.0" revision commit)) + (home-page "https://github.com/abo-abo/lispy") + (source (origin + (method git-fetch) + (uri (git-reference (url home-page) (commit commit))) + (sha256 + (base32 + "1g6756qqx2n4cx8jac6mlwayilsiyc5rz8nrqjnywvzc75xdinjd")) + (file-name (git-file-name name version)))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-ace-window" ,emacs-ace-window) + ("emacs-iedit" ,emacs-iedit) + ("emacs-ivy" ,emacs-ivy) + ("emacs-hydra" ,emacs-hydra) + ("emacs-zoutline" ,emacs-zoutline))) + (synopsis "Modal S-expression editing") + (description + "Due to the structure of Lisp syntax it's very rare for the programmer +to want to insert characters right before \"(\" or right after \")\". Thus +unprefixed printable characters can be used to call commands when the point is +at one of these special locations. Lispy provides unprefixed keybindings for +S-expression editing when point is at the beginning or end of an +S-expression.") + (license license:gpl3+)))) + +(define-public emacs-lispyville + ;; Later versions need a more recent Evil, with an evil-define-key* + ;; supporting nil for the state. + (let ((commit "b4291857ed6a49a67c4ea77522889ce51fb171ab") + (revision "0")) + (package + (name "emacs-lispyville") + (version (git-version "0.1" revision commit)) + (home-page "https://github.com/noctuid/lispyville") + (source (origin + (method git-fetch) + (uri (git-reference (url home-page) (commit commit))) + (sha256 + (base32 + "095zibzc3naknahdrnb59g9rbljy8wz9rkc7rf8avb3wxlwvxhm3")) + (file-name (git-file-name name version)))) + (propagated-inputs + `(("emacs-evil" ,emacs-evil) + ("emacs-lispy" ,emacs-lispy))) + (build-system emacs-build-system) + (synopsis "Minor mode for integrating Evil with lispy") + (description + "LispyVille's main purpose is to provide a Lisp editing environment +suited towards Evil users. It can serve as a minimal layer on top of lispy +for better integration with Evil, but it does not require the use of lispy’s +keybinding style. The provided commands allow for editing Lisp in normal +state and will work even without lispy being enabled.") + (license license:gpl3+)))) + +(define-public emacs-clojure-mode + (package + (name "emacs-clojure-mode") + (version "5.6.1") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/clojure-emacs/clojure-mode/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1f4k1hncy5ygh4izn7mqfp744nnisrp9ywn2njknbjxx34ai1q88")))) + (build-system emacs-build-system) + (native-inputs + `(("emacs-dash" ,emacs-dash) + ("emacs-s" ,emacs-s) + ("ert-runner" ,emacs-ert-runner))) + (arguments + `(#:tests? #t + #:test-command '("ert-runner"))) + (home-page "https://github.com/clojure-emacs/clojure-mode") + (synopsis "Major mode for Clojure code") + (description + "This Emacs package provides font-lock, indentation, navigation and basic +refactoring for the @uref{http://clojure.org, Clojure programming language}. +It is recommended to use @code{clojure-mode} with paredit or smartparens.") + (license license:gpl3+))) + +(define-public emacs-epl + (package + (name "emacs-epl") + (version "0.8") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/cask/epl/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1511n3a3f5gvaf2b4nh018by61ciyzi3y3603fzqma7p9hrckarc")))) + (build-system emacs-build-system) + (home-page "https://github.com/cask/epl") + (synopsis "Emacs Package Library") + (description + "A package management library for Emacs, based on @code{package.el}. + +The purpose of this library is to wrap all the quirks and hassle of +@code{package.el} into a sane API.") + (license license:gpl3+))) + +(define-public emacs-queue + (package + (name "emacs-queue") + (version "0.2") + (source (origin + (method url-fetch) + (uri (string-append "https://elpa.gnu.org/packages/queue-" + version ".el")) + (sha256 + (base32 + "0cx2848sqnnkkr4zisvqadzxngjyhmb36mh0q3if7q19yjjhmrkb")))) + (build-system emacs-build-system) + (home-page "http://www.dr-qubit.org/tags/computing-code-emacs.html") + (synopsis "Queue data structure for Emacs") + (description + "This Emacs library provides queue data structure. These queues can be +used both as a first-in last-out (FILO) and as a first-in first-out (FIFO) +stack, i.e. elements can be added to the front or back of the queue, and can +be removed from the front. This type of data structure is sometimes called an +\"output-restricted deque\".") + (license license:gpl3+))) + +(define-public emacs-pkg-info + (package + (name "emacs-pkg-info") + (version "0.6") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/lunaryorn/pkg-info.el/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1gy1jks5mmm02gg1c8gcyr4f8a9s5ggzhk56gv33b9mzjqzi5rd5")))) + (build-system emacs-build-system) + (propagated-inputs `(("emacs-epl" ,emacs-epl))) + (home-page "https://github.com/lunaryorn/pkg-info.el") + (synopsis "Information about Emacs packages") + (description + "This library extracts information from the installed Emacs packages.") + (license license:gpl3+))) + +(define-public emacs-spinner + (package + (name "emacs-spinner") + (version "1.7.3") + (source (origin + (method url-fetch) + (uri (string-append "https://elpa.gnu.org/packages/spinner-" + version ".el")) + (sha256 + (base32 + "19kp1mmndbmw11sgvv2ggfjl4pyf5zrsbh3871f0965pw9z8vahd")))) + (build-system emacs-build-system) + (home-page "https://github.com/Malabarba/spinner.el") + (synopsis "Emacs mode-line spinner for operations in progress") + (description + "This Emacs package adds spinners and progress-bars to the mode-line for +ongoing operations.") + (license license:gpl3+))) + +(define-public emacs-sparql-mode + (package + (name "emacs-sparql-mode") + (version "2.0.1") + (source (origin + (method url-fetch) + (uri (string-append "https://github.com/ljos/sparql-mode/archive/" + "v" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1s93mkllxnhy7fw616cnnc2danacdlarys0g3cn89drh0llh53cv")))) + (build-system emacs-build-system) + (home-page "https://github.com/ljos/sparql-mode") + (synopsis "SPARQL mode for Emacs") + (description "This package provides a major mode for Emacs that provides +syntax highlighting for SPARQL. It also provides a way to execute queries +against a SPARQL HTTP endpoint, such as is provided by Fuseki. It is also +possible to query other endpoints like DBPedia.") + (license license:gpl3+))) + +(define-public emacs-better-defaults + (package + (name "emacs-better-defaults") + (version "0.1.3") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/technomancy/better-defaults" + "/archive/" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "08fg4zslzlxbvyil5g4gwvwd22fh4zsgqprs5wh9hv1rgc6757m2")))) + (build-system emacs-build-system) + (home-page "https://github.com/technomancy/better-defaults") + (synopsis "Better defaults for Emacs") + (description + "Better defaults attempts to address the most obvious deficiencies of the +Emacs default configuration in uncontroversial ways that nearly everyone can +agree upon.") + (license license:gpl3+))) + +(define-public emacs-eprime + (let ((commit "17a481af26496be91c07139a9bfc05cfe722506f")) + (package + (name "emacs-eprime") + (version (string-append "20140513-" (string-take commit 7))) + (source (origin + (method url-fetch) + (uri (string-append "https://raw.githubusercontent.com" + "/AndrewHynes/eprime-mode/" + commit "/eprime-mode.el")) + (file-name (string-append "eprime-" version ".el")) + (sha256 + (base32 + "0v68lggkyq7kbcr9zyi573m2g2x251xy3jadlaw8kx02l8krwq8d")))) + (build-system emacs-build-system) + (home-page "https://github.com/AndrewHynes/eprime-mode") + (synopsis "E-prime checking mode for Emacs") + (description "This package provides an E-prime checking mode for Emacs +that highlights non-conforming text. The subset of the English language called +E-Prime forbids the use of the \"to be\" form to strengthen your writing.") + (license license:gpl3+)))) + +(define-public emacs-julia-mode + ;; XXX: Upstream version remained stuck at 0.3. See + ;; . + (let ((commit "115d4dc8a07445301772da8376b232fa8c7168f4") + (revision "1")) + (package + (name "emacs-julia-mode") + (version (string-append "0.3-" revision "." (string-take commit 8))) + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/JuliaEditorSupport/julia-emacs.git") + (commit commit))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "1is4dcv6blslpzbjcg8l2jpxi8xj96q4cm0nxjxsyswpm8bw8ki0")))) + (build-system emacs-build-system) + (arguments + `(#:tests? #t + #:test-command '("emacs" "--batch" + "-l" "julia-mode-tests.el" + "-f" "ert-run-tests-batch-and-exit"))) + (home-page "https://github.com/JuliaEditorSupport/julia-emacs") + (synopsis "Major mode for Julia") + (description "This Emacs package provides a mode for the Julia +programming language.") + (license license:expat)))) + +(define-public emacs-smex + (package + (name "emacs-smex") + (version "3.0") + (source (origin + (method url-fetch) + (uri (string-append "https://raw.githubusercontent.com" + "/nonsequitur/smex/" version "/smex.el")) + (file-name (string-append "smex-" version ".el")) + (sha256 + (base32 + "0ar310zx9k5y4i1vl2rawvi712xj9gx77160860jbs691p77cxqp")))) + (build-system emacs-build-system) + (home-page "https://github.com/nonsequitur/smex/") + (synopsis "M-x interface with Ido-style fuzzy matching") + (description + "Smex is a M-x enhancement for Emacs. Built on top of Ido, it provides a +convenient interface to your recently and most frequently used commands. And +to all the other commands, too.") + (license license:gpl3+))) + +(define-public emacs-js2-mode + (package + (name "emacs-js2-mode") + (version "20180301") + (source (origin + (method url-fetch) + (uri (string-append "https://github.com/mooz/js2-mode/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "13aghgwaqrmbf3pbifcry52kya454wnh1gbdh5805n1n6xgjm5w3")))) + (build-system emacs-build-system) + (home-page "https://github.com/mooz/js2-mode/") + (synopsis "Improved JavaScript editing mode for Emacs") + (description + "Js2-mode provides a JavaScript major mode for Emacs that is more +advanced than the built-in javascript-mode. Features include accurate syntax +highlighting using a recursive-descent parser, on-the-fly reporting of syntax +errors and strict-mode warnings, smart line-wrapping within comments and +strings, and code folding.") + (license license:gpl3+))) + +(define-public emacs-nodejs-repl + (package + (name "emacs-nodejs-repl") + (version "0.2.0") + (source (origin + (method url-fetch) + (uri (string-append "https://github.com/abicky/nodejs-repl.el" + "/archive/" version ".tar.gz")) + (sha256 + (base32 + "0hq2cqdq2668yf48g7qnkci90nhih1gnhacsgz355jnib56lhmkz")) + (file-name (string-append name "-" version ".tar.gz")))) + (build-system emacs-build-system) + (home-page "https://github.com/abicky/nodejs-repl.el") + (synopsis "Node.js REPL inside Emacs") + (description + "This program is derived from comint-mode and provides the following +features: + +@itemize +@item TAB completion same as Node.js REPL +@item file name completion in string +@item incremental history search +@end itemize") + (license license:gpl3+))) + +(define-public emacs-typescript-mode + (package + (name "emacs-typescript-mode") + (version "0.3") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/ananthakumaran/typescript.el" + "/archive/v" version ".tar.gz")) + (sha256 + (base32 + "1gqjirm8scf0wysm7x97zdfbs4qa5nqdl64jfbkd18iskv5mg3rj")) + (file-name (string-append name "-" version ".tar.gz")))) + (build-system emacs-build-system) + (home-page "https://github.com/ananthakumaran/typescript.el") + (synopsis "Emacs major mode for editing Typescript code") + (description + "This is based on Karl Landstrom's barebones @code{typescript-mode}. +This is much more robust and works with @code{cc-mode}'s comment +filling (mostly). The modifications to the original @code{javascript.el} mode +mainly consisted in replacing \"javascript\" with \"typescript\" + +The main features of this Typescript mode are syntactic highlighting (enabled +with @code{font-lock-mode} or @code{global-font-lock-mode}), automatic +indentation and filling of comments and C preprocessor fontification.") + (license license:gpl3+))) + +(define-public emacs-tide + (package + (name "emacs-tide") + (version "2.8.3.1") + (source (origin + (method url-fetch) + (uri (string-append "https://github.com/ananthakumaran/tide" + "/archive/v" version ".tar.gz")) + (sha256 + (base32 + "1k0kzqiv1hfs0kqm37947snzhrsmand3i9chvm6a2r5lb8v9q47y")) + (file-name (string-append name "-" version ".tar.gz")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-dash" ,emacs-dash) + ("emacs-s" ,emacs-s) + ("emacs-flycheck" ,emacs-flycheck) + ("emacs-typescript-mode" ,emacs-typescript-mode))) + (home-page "https://github.com/ananthakumaran/tide") + (synopsis "Typescript IDE for Emacs") + (description + "Tide is an Interactive Development Environment (IDE) for Emacs which +provides the following features: + +@itemize +@item ElDoc +@item Auto complete +@item Flycheck +@item Jump to definition, Jump to type definition +@item Find occurrences +@item Rename symbol +@item Imenu +@item Compile On Save +@item Highlight Identifiers +@item Code Fixes +@item Code Refactor +@item Organize Imports +@end itemize") + (license license:gpl3+))) + +(define-public emacs-markdown-mode + (package + (name "emacs-markdown-mode") + (version "2.3") + (source (origin + (method url-fetch) + (uri (string-append "https://raw.githubusercontent.com/jrblevin" + "/markdown-mode/v" version + "/markdown-mode.el")) + (file-name (string-append "markdown-mode-" version ".el")) + (sha256 + (base32 + "152whyrq3dqlqy5wv4mdd94kmal19hs5kwaxjcp2gp2r97lsmdmi")))) + (build-system emacs-build-system) + (home-page "http://jblevins.org/projects/markdown-mode/") + (synopsis "Emacs Major mode for Markdown files") + (description + "Markdown-mode is a major mode for editing Markdown-formatted text files +in Emacs.") + (license license:gpl3+))) + +(define-public emacs-edit-indirect + (package + (name "emacs-edit-indirect") + (version "0.1.5") + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/Fanael/edit-indirect") + (commit version))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "0by1x53pji39fjrj5bd446kz831nv0vdgw2jqasbym4pc1p2947r")))) + (build-system emacs-build-system) + (home-page "https://github.com/Fanael/edit-indirect") + (synopsis "Edit regions in separate buffers") + (description "This package allows you to edit regions in separate buffers, +like @code{org-edit-src-code} but for arbitrary regions.") + (license license:gpl3+))) + +(define-public emacs-projectile + (package + (name "emacs-projectile") + (version "0.14.0") + (source (origin + (method url-fetch) + (uri (string-append "https://raw.githubusercontent.com/bbatsov" + "/projectile/v" version "/projectile.el")) + (file-name (string-append "projectile-" version ".el")) + (sha256 + (base32 + "1ql1wnzhblbwnv66hf2y0wq45g71hh6s9inc090lmhm1vgylbd1f")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-dash" ,emacs-dash) + ("emacs-pkg-info" ,emacs-pkg-info))) + (home-page "https://github.com/bbatsov/projectile") + (synopsis "Manage and navigate projects in Emacs easily") + (description + "This library provides easy project management and navigation. The +concept of a project is pretty basic - just a folder containing special file. +Currently git, mercurial and bazaar repos are considered projects by default. +If you want to mark a folder manually as a project just create an empty +.projectile file in it.") + (license license:gpl3+))) + +(define-public emacs-elfeed + (package + (name "emacs-elfeed") + (version "3.0.0") + (source (origin + (method url-fetch) + (uri (string-append "https://github.com/skeeto/elfeed/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1wkdrxr6zzqb48czqqv34l87bx8aqjk1739ddqg933aqh241kfvn")))) + (build-system emacs-build-system) + (arguments + `(#:tests? #t + #:test-command '("make" "test"))) + (home-page "https://github.com/skeeto/elfeed") + (synopsis "Atom/RSS feed reader for Emacs") + (description + "Elfeed is an extensible web feed reader for Emacs, supporting both Atom +and RSS, with a user interface inspired by notmuch.") + (license license:gpl3+))) + +(define-public emacs-el-x + (package + (name "emacs-el-x") + (version "0.3.1") + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/sigma/el-x.git") + (commit (string-append "v" version)))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "1i6j44ssxm1xdg0mf91nh1lnprwsaxsx8vsrf720nan7mfr283h5")))) + (build-system emacs-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + ;; Move the source files to the top level, which is included in + ;; the EMACSLOADPATH. + (add-after 'unpack 'move-source-files + (lambda _ + (let ((el-files (find-files "./lisp" ".*\\.el$"))) + (for-each (lambda (f) + (rename-file f (basename f))) + el-files)) + #t))))) + (home-page "https://github.com/sigma/el-x") + (synopsis "Emacs Lisp extensions") + (description "command@{emacs-el-x} defines the @code{dflet} macro to +provide the historic behavior of @code{flet}, as well as +@code{declare-function} stub for older Emacs.") + (license license:gpl2+))) + +(define-public emacs-mocker + (package + (name "emacs-mocker") + (version "0.3.1") + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/sigma/mocker.el.git") + (commit (string-append "v" version)))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "1lav7am41v63xgavq8pr88y828jmd1cxd4prjq7jlbxm6nvrwxh2")))) + (build-system emacs-build-system) + (arguments + `(#:tests? #t + #:test-command '("ert-runner"))) + (native-inputs + `(("ert-runner" ,emacs-ert-runner))) + (propagated-inputs + `(("emacs-el-x" ,emacs-el-x))) + (home-page "https://github.com/sigma/mocker.el") + (synopsis "Mocking framework for Emacs Lisp") + (description "Mocker.el is a framework for writing tests in Emacs Lisp. +It uses regular Lisp rather than a domain specific language (DSL), which +maximizes flexibility (at the expense of conciseness).") + (license license:gpl2+))) + +(define-public emacs-find-file-in-project + (package + (name "emacs-find-file-in-project") + (version "5.4.7") + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/technomancy/find-file-in-project.git") + (commit version))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "1sdnyqv69mipbgs9yax88m9b6crsa59rjhwrih197pifl4089awr")))) + (build-system emacs-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-before 'check 'set-shell + ;; Otherwise Emacs shell-file-name is set to "/bin/sh", which doesn't + ;; work. + (lambda _ + (setenv "SHELL" (which "sh")) + #t))) + #:tests? #t + #:test-command '("./tests/test.sh"))) + (home-page "https://github.com/technomancy/find-file-in-project") + (synopsis "File/directory finder for Emacs") + (description "@code{find-file-in-project} allows to find files or +directories quickly in the current project. The project root is detected +automatically when Git, Subversion or Mercurial are used. It also provides +functions to assist in reviewing changes on files.") + (license license:gpl3+))) + +(define-public emacs-pyvenv + (package + (name "emacs-pyvenv") + (version "1.11") + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/jorgenschaefer/pyvenv.git") + (commit (string-append "v" version)))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "1a346qdimr1dvj53q033aqnahwd2dhyn9jadrs019nm0bzgw7g63")))) + (build-system emacs-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + ;; This phase incorrectly attempts to substitute "activate" and fails + ;; doing so. + (delete 'patch-el-files)) + #:tests? #t + #:test-command '("ert-runner"))) + (native-inputs + `(("ert-runner" ,emacs-ert-runner) + ("emacs-mocker" ,emacs-mocker))) + (home-page "https://github.com/jorgenschaefer/pyvenv") + (synopsis "Virtualenv minor mode for Emacs") + (description "pyvenv.el is a minor mode to support using Python virtual +environments (virtualenv) inside Emacs.") + (license license:gpl3+))) + +(define-public emacs-highlight-indentation + (package + (name "emacs-highlight-indentation") + (version "0.7.0") + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/antonj/Highlight-Indentation-for-Emacs.git") + (commit (string-append "v" version)))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "00l54k75qk24a0znzl4ij3s3nrnr2wy9ha3za8apphzlm98m907k")))) + (build-system emacs-build-system) + (home-page "https://github.com/antonj/Highlight-Indentation-for-Emacs/") + (synopsis "Highlighting indentation for Emacs") + (description "Provides two minor modes to highlight indentation guides in Emacs: +@enumerate +@item @code{highlight-indentation-mode}, which displays guidelines +indentation (space indentation only). +@item @code{highlight-indentation-current-column-mode}, which displays guidelines for the current-point indentation (space indentation only). +@end enumerate") + (license license:gpl2+))) + +(define-public emacs-elpy + (package + (name "emacs-elpy") + (version "1.27.0") + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/jorgenschaefer/elpy.git") + (commit version))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "1b76y0kzk7s9ya8k9bpsgn31i9l0rxs4iz6lg7snhjgh03k0ssgv")))) + (build-system emacs-build-system) + (arguments + `(#:include (cons* "^elpy/[^/]+\\.py$" "^snippets\\/" %default-include) + #:phases + ;; TODO: Make `elpy-config' display Guix commands :) + (modify-phases %standard-phases + ;; One elpy test depends on being run inside a Python virtual + ;; environment to pass. We have nothing to gain from doing so here, + ;; so we just trick Elpy into thinking we are (see: + ;; https://github.com/jorgenschaefer/elpy/pull/1293). + (add-before 'check 'fake-virtualenv + (lambda _ + (setenv "VIRTUAL_ENV" "/tmp") + #t)) + (add-before 'check 'build-doc + (lambda _ + (with-directory-excursion "docs" + (invoke "make" "info" "man")) + ;; Move .info file at the root so that it can installed by the + ;; 'move-doc phase. + (rename-file "docs/_build/texinfo/Elpy.info" "Elpy.info") + #t)) + (add-after 'build-doc 'install-manpage + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (man1 (string-append out "/share/man/man1"))) + (mkdir-p man1) + (copy-file "docs/_build/man/elpy.1" + (string-append man1 "/elpy.1"))) + #t))) + #:tests? #t + #:test-command '("ert-runner"))) + (propagated-inputs + `(("emacs-company" ,emacs-company) + ("emacs-find-file-in-project" ,emacs-find-file-in-project) + ("emacs-highlight-indentation" ,emacs-highlight-indentation) + ("emacs-yasnippet" ,emacs-yasnippet) + ("pyvenv" ,emacs-pyvenv) + ("s" ,emacs-s))) + (native-inputs + `(("ert-runner" ,emacs-ert-runner) + ("emacs-f" ,emacs-f) + ("python" ,python-wrapper) + ("python-autopep8" ,python-autopep8) + ("python-black" ,python-black) + ("python-flake8" ,python-flake8) + ("python-jedi" ,python-jedi) + ("python-yapf" ,python-yapf) + ;; For documentation. + ("python-sphinx" ,python-sphinx) + ("texinfo" ,texinfo))) + (home-page "https://github.com/jorgenschaefer/elpy") + (synopsis "Python development environment for Emacs") + (description "Elpy brings powerful Python editing to Emacs. It combines +and configures a number of other packages written in Emacs Lisp as well as +Python, together offering features such as navigation, documentation, +completion, interactive development and more.") + (license license:gpl3+))) + +(define-public emacs-rainbow-delimiters + (package + (name "emacs-rainbow-delimiters") + (version "2.1.3") + (source (origin + (method url-fetch) + (uri (string-append "https://raw.githubusercontent.com/Fanael" + "/rainbow-delimiters/" version + "/rainbow-delimiters.el")) + (file-name (string-append "rainbow-delimiters-" version ".el")) + (sha256 + (base32 + "1b3kampwsjabhcqdp0khgff13wc5jqhy3rbvaa12vnv7qy22l9ck")))) + (build-system emacs-build-system) + (home-page "https://github.com/Fanael/rainbow-delimiters") + (synopsis "Highlight brackets according to their depth") + (description + "Rainbow-delimiters is a \"rainbow parentheses\"-like mode for Emacs which +highlights parentheses, brackets, and braces according to their depth. Each +successive level is highlighted in a different color, making it easy to spot +matching delimiters, orient yourself in the code, and tell which statements +are at a given level.") + (license license:gpl3+))) + +(define-public emacs-rainbow-identifiers + (package + (name "emacs-rainbow-identifiers") + (version "0.2.2") + (source (origin + (method url-fetch) + (uri (string-append "https://raw.githubusercontent.com/Fanael" + "/rainbow-identifiers/" version + "/rainbow-identifiers.el")) + (file-name (string-append "rainbow-identifiers-" version ".el")) + (sha256 + (base32 + "0325abxj47k0g1i8nqrq70w2wr6060ckhhf92krv1s072b3jzm31")))) + (build-system emacs-build-system) + (home-page "https://github.com/Fanael/rainbow-identifiers") + (synopsis "Highlight identifiers in source code") + (description + "Rainbow identifiers mode is an Emacs minor mode providing highlighting of +identifiers based on their names. Each identifier gets a color based on a hash +of its name.") + (license license:bsd-2))) + +(define-public emacs-rainbow-mode + (package + (name "emacs-rainbow-mode") + (version "1.0.1") + (source (origin + (method url-fetch) + (uri (string-append + "http://elpa.gnu.org/packages/rainbow-mode-" version ".el")) + (sha256 + (base32 + "0cpga4ax635rfpj7y2vmh7ank0yw00dcy20gjg1mj74r97by8csf")))) + (build-system emacs-build-system) + (home-page "http://elpa.gnu.org/packages/rainbow-mode.html") + (synopsis "Colorize color names in buffers") + (description + "This minor mode sets background color to strings that match color +names, e.g. #0000ff is displayed in white with a blue background.") + (license license:gpl3+))) + +(define-public emacs-visual-fill-column + (package + (name "emacs-visual-fill-column") + (version "1.11") + (source (origin + (method url-fetch) + (uri (string-append "https://codeload.github.com/joostkremers/" + "visual-fill-column/tar.gz/" version)) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "13jnviakp607zcms7f8ams56mr8wffnq1pghlc6fvqs39663pgwh")))) + (build-system emacs-build-system) + (home-page "https://github.com/joostkremers/visual-fill-column") + (synopsis "Fill-column for visual-line-mode") + (description + "@code{visual-fill-column-mode} is a small Emacs minor mode that mimics +the effect of @code{fill-column} in @code{visual-line-mode}. Instead of +wrapping lines at the window edge, which is the standard behaviour of +@code{visual-line-mode}, it wraps lines at @code{fill-column}. If +@code{fill-column} is too large for the window, the text is wrapped at the +window edge.") + (license license:gpl3+))) + +(define-public emacs-writeroom + (package + (name "emacs-writeroom") + (version "3.7") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/joostkremers/writeroom-mode/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0yqgp5h3kvvpgva4azakb2wnjl7gsyh45glf75crspv3xyq57f2r")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-visual-fill-column" ,emacs-visual-fill-column))) + (home-page "https://github.com/joostkremers/writeroom-mode") + (synopsis "Distraction-free writing for Emacs") + (description + "This package defines a minor mode for distraction-free writing. Some of +the default effects include entering fullscreen, deleting other windows of the +current frame, disabling the mode line, and adding margins to the buffer that +restrict the text width to 80 characters.") + (license license:bsd-3))) + +(define-public emacs-ido-completing-read+ + (package + (name "emacs-ido-completing-read+") + (version "3.12") + (source (origin + (method url-fetch) + (uri (string-append "https://raw.githubusercontent.com" + "/DarwinAwardWinner/ido-ubiquitous/v" + version "/ido-completing-read+.el")) + (file-name (string-append "ido-completing-read+-" version ".el")) + (sha256 + (base32 + "1cyalb0p7nfsm4n6n9q6rjmvn6adqc0fq8ybnlj3n41n289dkfjf")))) + (build-system emacs-build-system) + (home-page "https://github.com/DarwinAwardWinner/ido-ubiquitous") + (synopsis "Replacement for completing-read using ido") + (description + "The ido-completing-read+ function is a wrapper for ido-completing-read. +Importantly, it detects edge cases that ordinary ido cannot handle and either +adjusts them so ido can handle them, or else simply falls back to the standard +Emacs completion function instead.") + (license license:gpl3+))) + +(define-public emacs-ido-ubiquitous + (package + (name "emacs-ido-ubiquitous") + (version "3.12") + (source (origin + (method url-fetch) + (uri (string-append "https://raw.githubusercontent.com" + "/DarwinAwardWinner/ido-ubiquitous/v" + version "/ido-ubiquitous.el")) + (file-name (string-append "ido-ubiquitous-" version ".el")) + (sha256 + (base32 + "197ypji0fb6jsdcq40rpnknwlh3imas6s6jbsvkfm0pz9988c3q2")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-ido-completing-read+" ,emacs-ido-completing-read+))) + (home-page "https://github.com/DarwinAwardWinner/ido-ubiquitous") + (synopsis "Use ido (nearly) everywhere") + (description + "Ido-ubiquitous enables ido-style completion for almost every function +that uses the standard completion function completing-read.") + (license license:gpl3+))) + +(define-public emacs-yaml-mode + (package + (name "emacs-yaml-mode") + (version "0.0.13") + (source (origin + (method url-fetch) + (uri (string-append "https://raw.githubusercontent.com/yoshiki" + "/yaml-mode/v" version "/yaml-mode.el")) + (file-name (string-append "yaml-mode-" version ".el")) + (sha256 + (base32 + "0im88sk9dqw03x6d6zaspgvg9i0pfpgb8f2zygrmbifh2w4pwmvj")))) + (build-system emacs-build-system) + (home-page "https://github.com/yoshiki/yaml-mode") + (synopsis "Major mode for editing YAML files") + (description + "Yaml-mode is an Emacs major mode for editing files in the YAML data +serialization format. It was initially developed by Yoshiki Kurihara and many +features were added by Marshall Vandegrift. As YAML and Python share the fact +that indentation determines structure, this mode provides indentation and +indentation command behavior very similar to that of python-mode.") + (license license:gpl3+))) + +(define-public emacs-web-mode + (package + (name "emacs-web-mode") + (version "16") + (source (origin + (method url-fetch) + (uri (string-append "https://raw.githubusercontent.com/fxbois" + "/web-mode/v" version "/web-mode.el")) + (file-name (string-append "web-mode-" version ".el")) + (sha256 + (base32 + "1hs5w7kdvcyn4ihyw1kfjg48djn5p7lz4rlbhzzdqv1g56xqx3gw")))) + (build-system emacs-build-system) + (synopsis "Major mode for editing web templates") + (description "Web-mode is an Emacs major mode for editing web templates +aka HTML files embedding parts (CSS/JavaScript) and blocks (pre rendered by +client/server side engines). Web-mode is compatible with many template +engines: PHP, JSP, ASP, Django, Twig, Jinja, Mustache, ERB, FreeMarker, +Velocity, Cheetah, Smarty, CTemplate, Mustache, Blade, ErlyDTL, Go Template, +Dust.js, React/JSX, Angularjs, ejs, etc.") + (home-page "http://web-mode.org/") + (license license:gpl3+))) + +(define-public emacs-wgrep + (let ((commit "414be70bd313e482cd9f0b70fd2daad4ee23497c")) + ;; Late commit fixes compatibility issue with Emacs 26+. + (package + (name "emacs-wgrep") + (version (git-version "2.1.10" "1" commit)) + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/mhayashi1120/Emacs-wgrep") + (commit commit))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "1sdhd587q3pg92lhiayph87azhalmf1gzrnsprkmqvnphv7mvks9")))) + (build-system emacs-build-system) + (home-page "https://github.com/mhayashi1120/Emacs-wgrep") + (synopsis "Edit a grep buffer and apply those changes to the files") + (description + "Emacs wgrep allows you to edit a grep buffer and apply those changes +to the file buffer. Several backends are supported beside the classic grep: +ack, ag, helm and pt.") + (license license:gpl3+)))) + +(define-public emacs-helm + (package + (name "emacs-helm") + (version "3.0") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/" name "/helm/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0k2r0ccppaqfjvyszaxa16vf7g2qzj1clhfr6v646ncsy17laciw")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-async" ,emacs-async) + ("emacs-popup" ,emacs-popup))) + (home-page "https://emacs-helm.github.io/helm/") + (synopsis "Incremental completion and selection narrowing +framework for Emacs") + (description "Helm is incremental completion and selection narrowing +framework for Emacs. It will help steer you in the right direction when +you're looking for stuff in Emacs (like buffers, files, etc). Helm is a fork +of @code{anything.el} originally written by Tamas Patrovic and can be +considered to be its successor. Helm sets out to clean up the legacy code in +@code{anything.el} and provide a cleaner, leaner and more modular tool, that's +not tied in the trap of backward compatibility.") + (license license:gpl3+))) + +(define-public emacs-helm-swoop + (package + (name "emacs-helm-swoop") + (version "1.7.4") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/ShingoFukuyama/helm-swoop/archive/" + version + ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1ssivsjzlnkg049cg993l8fp09l5nhpz6asj7w5c91zp5kpc6fh7")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-helm" ,emacs-helm))) + (home-page "https://github.com/ShingoFukuyama/helm-swoop") + (synopsis "Filter and jump to lines in an Emacs buffer using Helm") + (description + "This package builds on the Helm interface to provide several commands +for search-based navigation of buffers.") + (license license:gpl2+))) + +(define-public emacs-helm-projectile + (package + (name "emacs-helm-projectile") + (version "0.14.0") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/bbatsov/helm-projectile/archive/v" + version + ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "19cfmilqh8kbab3b2hmx6lyrj73q6vfmn3p730x95g23iz16mnd5")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-dash" ,emacs-dash) + ("emacs-helm" ,emacs-helm) + ("emacs-projectile" ,emacs-projectile))) + (home-page "https://github.com/bbatsov/helm-projectile") + (synopsis "Helm integration for Projectile") + (description + "This Emacs library provides a Helm interface for Projectile.") + (license license:gpl3+))) + +(define-public emacs-helm-make + (let ((commit "feae8df22bc4b20705ea08ac9adfc2b43bb348d0") + (revision "1")) + (package + (name "emacs-helm-make") + (version (string-append "0.1.0-" revision "." (string-take commit 7))) + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/abo-abo/helm-make.git") + (commit commit))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "1y2v77mmd1bfkkz51cnk1l0dg3lvvxc39wlamnm7wjns66dbvlam")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-helm" ,emacs-helm) + ("emacs-projectile" ,emacs-projectile))) + (home-page "https://github.com/abo-abo/helm-make") + (synopsis "Select a Makefile target with helm") + (description "@code{helm-make} or @code{helm-make-projectile} will give +you a @code{helm} selection of directory Makefile's targets. Selecting a +target will call @code{compile} on it.") + (license license:gpl3+)))) + +(define-public emacs-cider + (package + (name "emacs-cider") + (version "0.18.0") + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/clojure-emacs/cider.git") + (commit (string-append "v" version)))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "1m9kc88vga3q5d731qnpngnsa0n57pf21k3hll20rw8rggrx4vdn")))) + (build-system emacs-build-system) + (arguments + '(#:exclude ; Don't exclude 'cider-test.el'. + '("^\\.dir-locals\\.el$" "^test/"))) + (propagated-inputs + `(("emacs-clojure-mode" ,emacs-clojure-mode) + ("emacs-sesman" ,emacs-sesman) + ("emacs-spinner" ,emacs-spinner) + ("emacs-pkg-info" ,emacs-pkg-info) + ("emacs-queue" ,emacs-queue))) + (home-page "https://cider.readthedocs.io/") + (synopsis "Clojure development environment for Emacs") + (description + "CIDER (Clojure Interactive Development Environment that Rocks) aims to +provide an interactive development experience similar to the one you'd get +when programming in Emacs Lisp, Common Lisp (with SLIME or Sly), Scheme (with +Geiser) and Smalltalk. + +CIDER is the successor to the now deprecated combination of using SLIME + +swank-clojure for Clojure development. + +There are plenty of differences between CIDER and SLIME, but the core ideas +are pretty much the same (and SLIME served as the principle inspiration for +CIDER).") + (license license:gpl3+))) + +;; There hasn't been a tag or release since 2015, so we take the latest +;; commit. +(define-public emacs-sly + (let ((commit "486bfbe95612bcdc0960c490207970a188e0fbb9") + (revision "1")) + (package + (name "emacs-sly") + (version (string-append "1.0.0-" revision "." (string-take commit 9))) + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/joaotavora/sly.git") + (commit commit))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "0ib4q4k3h3qn88pymyjjmlmnpizdn1mfg5gpk5a715nqsgxlg09l")))) + (build-system emacs-build-system) + (arguments + `(#:include (cons "^lib\\/" %default-include) + #:phases + ;; The package provides autoloads. + (modify-phases %standard-phases + (delete 'make-autoloads)))) + (home-page "https://github.com/joaotavora/sly") + (synopsis "Sylvester the Cat's Common Lisp IDE") + (description + "SLY is Sylvester the Cat's Common Lisp IDE. SLY is a fork of SLIME, and +contains the following improvements over it: + +@enumerate +@item Completely redesigned REPL based on Emacs's own full-featured + @code{comint.el} +@item Live code annotations via a new @code{sly-stickers} contrib +@item Consistent interactive button interface. Everything can be copied to + the REPL. +@item Multiple inspectors with independent history +@item Regexp-capable @code{M-x sly-apropos} +@item Contribs are first class SLY citizens and enabled by default +@item Use ASDF to loads contribs on demand. +@end enumerate + +SLY tracks SLIME's bugfixes and all its familar features (debugger, inspector, +xref, etc...) are still available, but with better integration.") + (license license:gpl3+)))) + +(define-public emacs-lua-mode + (let ((commit "652e299cb967fccca827dda381d61a9c144d97de") + (revision "1")) + (package + (name "emacs-lua-mode") + (version (string-append "20151025." revision "-" (string-take commit 9))) + (home-page "https://github.com/immerrr/lua-mode/") + (source (origin + (method git-fetch) + (uri (git-reference + (url home-page) + (commit commit))) + (file-name (string-append name "-" version ".checkout")) + (sha256 + (base32 + "053025k930wh0lak6rc1973ynfrmm8zsyzfqhhd39x7abkl41hc9")))) + (build-system emacs-build-system) + (synopsis "Major mode for lua") + (description + "This Emacs package provides a mode for @uref{https://www.lua.org/, +Lua programing language}.") + (license license:gpl2+)))) + +(define-public emacs-ebuild-mode + (package + (name "emacs-ebuild-mode") + (version "1.37") + (source (origin + (method url-fetch) + (uri (string-append + "https://dev.gentoo.org/~ulm/emacs/ebuild-mode" + "-" version ".tar.xz")) + (file-name (string-append name "-" version ".tar.xz")) + (sha256 + (base32 + "07dzrdjjczkxdfdgi60h4jjkvzi4p0k9rij2wpfp8s03ay3qldpp")))) + (build-system emacs-build-system) + (home-page "https://devmanual.gentoo.org") + (synopsis "Major modes for Gentoo package files") + (description + "This Emacs package provides modes for ebuild, eclass, eblit, GLEP42 +news items, openrc and runscripts.") + (license license:gpl2+))) + +(define-public emacs-evil + (let ((commit "230b87212c81aaa68ef5547a6b998d9c365fe139")) + (package + (name "emacs-evil") + (version (git-version "1.2.13" "1" commit)) + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/emacs-evil/evil") + (commit commit))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "0c9zy3bpck10gcrv79kd3h7i4ygd5bgbgy773n0lg7a2r5kwn1gx")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-undo-tree" ,emacs-undo-tree) + ("emacs-goto-chg" ,emacs-goto-chg))) + (home-page "https://github.com/emacs-evil/evil") + (synopsis "Extensible Vi layer for Emacs") + (description + "Evil is an extensible vi layer for Emacs. It emulates the +main features of Vim, and provides facilities for writing custom +extensions.") + (license license:gpl3+)))) + +(define-public emacs-evil-collection + (let ((commit "4e1f0e0b17153d460805a0da90d6191d66b2673d") + (revision "5")) + (package + (name "emacs-evil-collection") + (version (git-version "0.0.1" revision commit)) + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/emacs-evil/evil-collection") + (commit commit))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "11d5ppdnb2y2mwsdd9g62h7zds962kw3nss89zv5iwgcf9f1fb5x")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-evil" ,emacs-evil))) + (home-page "https://github.com/emacs-evil/evil-collection") + (synopsis "Collection of Evil bindings for many major and minor modes") + (description "This is a collection of Evil bindings for the parts of +Emacs that Evil does not cover properly by default, such as @code{help-mode}, +@code{M-x calendar}, Eshell and more.") + (license license:gpl3+)))) + +(define-public emacs-goto-chg + (package + (name "emacs-goto-chg") + (version "1.6") + (source + (origin + (method url-fetch) + ;; There is no versioned source. + (uri "https://www.emacswiki.org/emacs/download/goto-chg.el") + (file-name (string-append "goto-chg-" version ".el")) + (sha256 + (base32 + "078d6p4br5vips7b9x4v6cy0wxf6m5ij9gpqd4g33bryn22gnpij")))) + (build-system emacs-build-system) + ;; There is no other home page. + (home-page "https://www.emacswiki.org/emacs/goto-chg.el") + (synopsis "Go to the last change in the Emacs buffer") + (description + "This package provides @code{M-x goto-last-change} command that goes to +the point of the most recent edit in the current Emacs buffer. When repeated, +go to the second most recent edit, etc. Negative argument, @kbd{C-u -}, is +used for reverse direction.") + (license license:gpl2+))) + +(define-public emacs-monroe + (package + (name "emacs-monroe") + (version "0.3.1") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/sanel/monroe/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0icdx8shkd951phlnmcq1vqaxp1l667q5rjscskc5r22aylakh4w")))) + (build-system emacs-build-system) + (home-page "https://github.com/sanel/monroe") + (synopsis "Clojure nREPL client for Emacs") + (description + "Monroe is a nREPL client for Emacs, focused on simplicity and easy +distribution, primarily targeting Clojure users") + (license license:gpl3+))) + +(define-public emacs-orgalist + (package + (name "emacs-orgalist") + (version "1.9") + (source + (origin + (method url-fetch) + (uri (string-append "https://elpa.gnu.org/packages/" + "orgalist-" version ".el")) + (sha256 + (base32 + "1rmmcyiiqkq54hn74nhzxzl4nvd902hv6gq341jwhrm7yiagffi6")))) + (build-system emacs-build-system) + (home-page "http://elpa.gnu.org/packages/orgalist.html") + (synopsis "Manage Org-like lists in non-Org buffers") + (description "Write Org mode's plain lists in non-Org buffers. More +specifically, Orgalist supports the syntax of Org mode for numbered, +unnumbered, description items, checkboxes, and counter cookies. + +The library also implements radio lists, i.e., lists written in Org +syntax later translated into the host format, e.g., LaTeX or HTML.") + (license license:gpl3+))) + +(define-public emacs-writegood-mode + (package + (name "emacs-writegood-mode") + (version "2.0.2") + (home-page "https://github.com/bnbeckwith/writegood-mode") + (source (origin + (method git-fetch) + (uri (git-reference + (url home-page) + (commit (string-append "v" version)))) + (sha256 + (base32 + "1nnjn1r669hvvzfycllwap4w04m8rfsk4nzcg8057m1f263kj31b")) + (file-name (string-append name "-checkout")))) + (build-system emacs-build-system) + (synopsis "Polish up poor writing on the fly") + (description + "This minor mode tries to find and highlight problems with your writing +in English as you type. It primarily detects \"weasel words\" and abuse of +passive voice.") + (license license:gpl3+))) + +(define-public emacs-neotree + (package + (name "emacs-neotree") + (version "0.5.2") + (home-page "https://github.com/jaypei/emacs-neotree") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/jaypei/" name + "/archive/" version ".tar.gz")) + (sha256 + (base32 + "1zd6dchwyijnf7kgchfcp51gs938l204dk9z6mljrfqf2zy0gp12")) + (file-name (string-append name "-" version ".tar.gz")))) + (build-system emacs-build-system) + (synopsis "Folder tree view for Emacs") + (description "This Emacs package provides a folder tree view.") + (license license:gpl3+))) + +(define-public emacs-org + (package + (name "emacs-org") + ;; emacs-org-contrib inherits from this package. Please update its sha256 + ;; checksum as well. + (version "9.2") + (source (origin + (method url-fetch) + (uri (string-append "http://elpa.gnu.org/packages/org-" + version ".tar")) + (sha256 + (base32 + "14ydwh2r360fpi6v2g9rgf0zazy2ddq1pcdxvzn73h65glnnclz9")))) + (build-system emacs-build-system) + (home-page "https://orgmode.org/") + (synopsis "Outline-based notes management and organizer") + (description "Org is an Emacs mode for keeping notes, maintaining TODO +lists, and project planning with a fast and effective lightweight markup +language. It also is an authoring system with unique support for literate +programming and reproducible research.") + (license license:gpl3+))) + +(define-public emacs-org-contrib + (package + (inherit emacs-org) + (name "emacs-org-contrib") + (version "20181230") + (source (origin + (method url-fetch) + (uri (string-append "https://orgmode.org/elpa/org-plus-contrib-" + version ".tar")) + (sha256 + (base32 + "0gibwcjlardjwq19bh0zzszv0dxxlml0rh5iikkcdynbgndk1aa1")))) + (arguments + `(#:modules ((guix build emacs-build-system) + (guix build utils) + (guix build emacs-utils) + (ice-9 ftw) + (srfi srfi-1)) + #:phases + (modify-phases %standard-phases + (add-after 'install 'delete-org-files + (lambda* (#:key inputs outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (org (assoc-ref inputs "org")) + (contrib-files + (map basename (find-files out))) + (org+contrib-files + (map basename (find-files org))) + (duplicates (lset-intersection + string=? contrib-files org+contrib-files))) + (with-directory-excursion + (string-append + out "/share/emacs/site-lisp/guix.d/org-contrib-" ,version) + (for-each delete-file duplicates)) + #t)))))) + (propagated-inputs + `(("arduino-mode" ,emacs-arduino-mode) + ("cider" ,emacs-cider) + ("org" ,emacs-org) + ("scel" ,emacs-scel))) + (synopsis "Contributed packages to Org mode") + (description "Org is an Emacs mode for keeping notes, maintaining TODO +lists, and project planning with a fast and effective plain-text system. + +This package is equivalent to org-plus-contrib, but only includes additional +files that you would find in @file{contrib/} from the git repository."))) + +(define-public emacs-flx + (package + (name "emacs-flx") + (version "0.6.1") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/lewang/" + "flx/archive/v" version ".tar.gz")) + (sha256 + (base32 + "0bkcpnf1j4i2fcc2rllwbz62l00sw2mcia6rm5amgwvlkqavmkv6")) + (file-name (string-append name "-" version ".tar.gz")))) + (build-system emacs-build-system) + (home-page "https://github.com/lewang/flx") + (synopsis "Fuzzy matching for Emacs") + (description + "Flx provides fuzzy matching for emacs a la sublime text. +The sorting algorithm is a balance between word beginnings (abbreviation) +and contiguous matches (substring). The longer the substring match, +the higher it scores. This maps well to how we think about matching. +Flx has support for ido (interactively do things) through flx-ido.") + (license license:gpl3+))) + +(define-public emacs-cyberpunk-theme + (package + (name "emacs-cyberpunk-theme") + (version "1.19") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/n3mo/cyberpunk-theme.el/" + "archive/" version ".tar.gz")) + (sha256 + (base32 + "05l5fxw1mn5py6mfhxrzyqjq0d8m5m1akfi46vrgh13r414jffvv")) + (file-name (string-append name "-" version ".tar.gz")))) + (build-system emacs-build-system) + (home-page "https://github.com/n3mo/cyberpunk-theme.el") + (synopsis "Cyberpunk theme for emacs built-in color theme support") + (description + "Cyberpunk color theme for the emacs 24+ built-in color theme support +known loosely as deftheme. Many mode-specific customizations are included.") + (license license:gpl3+))) + +(define-public emacs-danneskjold-theme + (let* ((commit "8733d2fe8743e8a01826ea6d4430ef376c727e57") + (revision "1")) + (package + (name "emacs-danneskjold-theme") + (version (string-append "0.0.0-" revision "." (string-take commit 7))) + (home-page "https://github.com/rails-to-cosmos/danneskjold-theme") + (source + (origin + (method git-fetch) + (uri (git-reference + (url home-page) + (commit commit))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "0s6rbsb0y8i8m5b9xm4gw1p1cxsxdqnqxqqb638pygz9f76mbir1")))) + (build-system emacs-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-after 'unpack 'delete-screenshots + (lambda _ + (delete-file-recursively "screenshots") #t))))) + (synopsis "High-contrast Emacs theme") + (description + "@code{danneskjold-theme} is a high-contrast theme for Emacs.") + (license license:gpl3+)))) + +(define-public emacs-dream-theme + (let* ((commit "107a11d74365046f28a1802a2bdb5e69e4a7488b") + (revision "1")) + (package + (name "emacs-dream-theme") + (version (string-append "0.0.0-" revision "." (string-take commit 7))) + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/djcb/dream-theme") + (commit commit))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "0za18nfkq4xqm35k6006vsixcbmvmxqgma4iw5sw37h8vmcsdylk")))) + (build-system emacs-build-system) + (home-page "https://github.com/djcb/dream-theme") + (synopsis "High-contrast Emacs theme") + (description + "@code{dream-theme} is a dark, clean theme for Emacs. It is inspired +by zenburn, sinburn and similar themes, but slowly diverging from them.") + (license license:gpl3+)))) + +(define-public emacs-auto-complete + (package + (name "emacs-auto-complete") + (version "1.5.1") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/auto-complete/" + "auto-complete/archive/v" version ".tar.gz")) + (sha256 + (base32 + "1jvq4lj00hwml75lpmlciazy8f3bbg13gffsfnl835p4qd8l7yqv")) + (file-name (string-append name "-" version ".tar.gz")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-popup" ,emacs-popup))) + (home-page "https://github.com/auto-complete/auto-complete") + (synopsis "Intelligent auto-completion extension for Emacs") + (description + "Auto-Complete is an intelligent auto-completion extension for Emacs. +It extends the standard Emacs completion interface and provides an environment +that allows users to concentrate more on their own work. Its features are: +a visual interface, reduce overhead of completion by using statistic method, +extensibility.") + (license license:gpl3+))) + +(define-public emacs-nginx-mode + (package + (name "emacs-nginx-mode") + (version "1.1.9") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/ajc/nginx-mode/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0bzyrj6zz1hm67bkhw23bam7qc869s3zg7m1rb1c3aa4n0aw90cq")))) + (build-system emacs-build-system) + (home-page "https://github.com/ajc/nginx-mode") + (synopsis "Emacs major mode for editing nginx config files") + (description "This package provides an Emacs major mode for +editing nginx config files.") + (license license:gpl2+))) + +(define-public emacs-stream + (package + (name "emacs-stream") + (version "2.2.0") + (home-page "https://github.com/NicolasPetton/stream") + (source + (origin + (method url-fetch) + (file-name (string-append name "-" version ".tar.gz")) + (uri (string-append home-page "/archive/"version ".tar.gz")) + (sha256 + (base32 "03ql4nqfz5pn55mjly6clhvc3g7x2d28kj7mrlqmigvjbql39xxc")))) + (build-system emacs-build-system) + (synopsis "Implementation of streams for Emacs") + (description "This library provides an implementation of streams for Emacs. +Streams are implemented as delayed evaluation of cons cells.") + (license license:gpl3+))) + +(define-public emacs-el-search + (let ((commit "f26277bfbb3fc3fc74beea6592f294c439796bd4") + (revision "1")) + (package + (name "emacs-el-search") + ;; No ufficial release. + (version (string-append "0.0-" revision "." (string-take commit 7))) + (home-page "https://github.com/emacsmirror/el-search") + (source + (origin + (method git-fetch) + (file-name (string-append name "-" version ".tar.gz")) + (uri (git-reference + (commit commit) + (url (string-append home-page ".git")))) + (sha256 + (base32 "12xf40h9sb7xxg2r97gsia94q02543mgiiiw46fzh1ac7b7993g6")))) + (build-system emacs-build-system) + (inputs `(("emacs-stream" ,emacs-stream))) + (synopsis "Expression based interactive search for emacs-lisp-mode") + (description "This package provides expression based interactive search +procedures for emacs-lisp-mode.") + (license license:gpl3+)))) + +(define-public emacs-ht + (package + (name "emacs-ht") + (version "2.1") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/Wilfred/ht.el/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1lpba36kzxcc966fvsbrfpy8ah9gnvay0yk26gbyjil0rggrbqzj")))) + (build-system emacs-build-system) + (propagated-inputs `(("emacs-dash" ,emacs-dash))) + (home-page "https://github.com/Wilfred/ht.el") + (synopsis "Hash table library for Emacs") + (description + "This package simplifies the use of hash tables in elisp. It also +provides functions to convert hash tables from and to alists and plists.") + (license license:gpl3+))) + +(define-public emacs-log4e + (package + (name "emacs-log4e") + (version "0.3.0") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/aki2o/log4e/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0nbdpbw353snda3v19l9hsm6gimppwnpxj18amm350bm81lyim2g")))) + (build-system emacs-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-after 'unpack 'remove-tests + ;; Guile builder complains about null characters in some + ;; strings of test files. Remove "test" directory (it is not + ;; needed anyway). + (lambda _ + (delete-file-recursively "test")))))) + (home-page "https://github.com/aki2o/log4e") + (synopsis "Logging framework for elisp") + (description + "This package provides a logging framework for elisp. It allows +you to deal with multiple log levels.") + (license license:gpl3+))) + +(define-public emacs-gntp + (package + (name "emacs-gntp") + (version "0.1") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/tekai/gntp.el/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "16c1dfkia9yhl206bdhjr3b8kfvqcqr38jl5lq8qsyrrzsnmghny")))) + (build-system emacs-build-system) + (home-page "https://github.com/tekai/gntp.el") + (synopsis "Growl Notification Protocol for Emacs") + (description + "This package implements the Growl Notification Protocol GNTP +described at @uref{http://www.growlforwindows.com/gfw/help/gntp.aspx}. +It is incomplete as it only lets you send but not receive +notifications.") + (license license:bsd-3))) + +(define-public emacs-alert + (package + (name "emacs-alert") + (version "1.2") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/jwiegley/alert/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1693kck3k2iz5zhpmxwqyafxm68hr6gzs60lkxd3j1wlp2c9fwyr")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-gntp" ,emacs-gntp) + ("emacs-log4e" ,emacs-log4e))) + (home-page "https://github.com/jwiegley/alert") + (synopsis "Growl-style notification system for Emacs") + (description + "Alert is a Growl-workalike for Emacs which uses a common notification +interface and multiple, selectable \"styles\", whose use is fully +customizable by the user.") + (license license:gpl2+))) + +(define-public emacs-mu4e-alert + (package + (name "emacs-mu4e-alert") + (version "1.0") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/iqbalansari/mu4e-alert/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "07qc834qnxn8xi4bw5nawj8g91bmkzw0r0vahkgysp7r9xrf57gj")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-alert" ,emacs-alert) + ("emacs-s" ,emacs-s) + ("emacs-ht" ,emacs-ht) + ("mu" ,mu))) + (home-page "https://github.com/iqbalansari/mu4e-alert") + (synopsis "Desktop notification for mu4e") + (description + "This package provides desktop notifications for mu4e. +Additionally it can display the number of unread emails in the +mode-line.") + (license license:gpl3+))) + +(define-public emacs-pretty-mode + (package + (name "emacs-pretty-mode") + (version "2.0.3") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/akatov/pretty-mode/" + "archive/" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1fan7m4vnqs8kpg7r54kx3g7faadkpkf9kzarfv8n57kq8w157pl")))) + (build-system emacs-build-system) + (home-page "https://github.com/akatov/pretty-mode") + (synopsis "Redisplay parts of the buffer as Unicode symbols") + (description + "Emacs minor mode for redisplaying parts of the buffer as pretty symbols.") + (license license:gpl3+))) + +(define-public emacs-yasnippet + (package + (name "emacs-yasnippet") + (version "0.13.0") + (source (origin + (method url-fetch) + (uri (string-append "https://github.com/joaotavora/yasnippet/" + "archive/" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "12ls2x17agzbrj1xynjbmfa11igqxia4hj4fv6fpr66yci2r1plc")) + (modules '((guix build utils))) + (snippet + '(begin + ;; YASnippet expects a "snippets" subdirectory in the same + ;; directory as yasnippet.el, but we don't install it + ;; because it's a git submodule pointing to an external + ;; repository. Adjust `yas-snippet-dirs' to prevent + ;; warnings about a missing directory. + (substitute* "yasnippet.el" + (("^ +'yas-installed-snippets-dir\\)\\)\n") + "))\n")) + #t)))) + (build-system emacs-build-system) + (home-page "https://github.com/joaotavora/yasnippet") + (synopsis "Yet another snippet extension for Emacs") + (description + "YASnippet is a template system for Emacs. It allows you to type an +abbreviation and automatically expand it into function templates.") + (license license:gpl3+))) + +(define-public emacs-yasnippet-snippets + (let ((commit "885050d34737e2fb36a3e7759d60c09347bd4ce0") + (revision "1")) + (package + (name "emacs-yasnippet-snippets") + (version (string-append "1-" revision "." (string-take commit 8))) + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/AndreaCrotti/yasnippet-snippets") + (commit commit))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "1m935zgglw0iakzrixld5rcjz3wnj84f8wy2mvc3pggjri9l0qr9")))) + (build-system trivial-build-system) + (arguments + `(#:modules ((ice-9 ftw) + (ice-9 regex) + (guix build utils)) + #:builder + (begin + (use-modules (ice-9 ftw) + (ice-9 regex) + (guix build utils)) + (with-directory-excursion (assoc-ref %build-inputs "source") + (for-each (lambda (dir) + (copy-recursively + dir + (string-append %output + "/share/emacs/yasnippet-snippets/" + dir))) + (scandir "." (lambda (fname) + (and (string-match "-mode$" fname) + (directory-exists? fname)))))) + #t))) + (home-page "https://github.com/AndreaCrotti/yasnippet-snippets") + (synopsis "Collection of YASnippet snippets for many languages") + (description + "Provides Andrea Crotti's collection of YASnippet snippets. After installation, +the snippets will be in \"~/.guix-profile/share/emacs/yasnippet-snippets/\". +To make YASnippet aware of these snippets, add the above directory to +@code{yas-snippet-dirs}.") + (license license:expat)))) + +(define-public emacs-helm-c-yasnippet + (let ((commit "65ca732b510bfc31636708aebcfe4d2d845b59b0") + (revision "1")) + (package + (name "emacs-helm-c-yasnippet") + (version (string-append "0.6.7" "-" revision "." + (string-take commit 7))) + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/emacs-jp/helm-c-yasnippet") + (commit commit))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "1cbafjqlzxbg19xfdqsinsh7afq58gkf44rsg1qxfgm8g6zhr7f8")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-helm" ,emacs-helm) + ("emacs-yasnippet" ,emacs-yasnippet))) + (home-page "https://github.com/emacs-jp/helm-c-yasnippet") + (synopsis "Helm integration for Yasnippet") + (description "This Emacs library provides Helm interface for +Yasnippet.") + (license license:gpl2+)))) + +(define-public emacs-helm-system-packages + (package + (name "emacs-helm-system-packages") + (version "1.10.1") + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/emacs-helm/helm-system-packages") + (commit (string-append "v" version)))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "01by0c4lqi2cw8xmbxkjw7m9x78zssm31sx4hdpw5j35s2951j0f")))) + (build-system emacs-build-system) + (inputs + `(("recutils" ,recutils))) + (propagated-inputs + `(("emacs-helm" ,emacs-helm))) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-after 'unpack 'configure + (lambda* (#:key inputs outputs #:allow-other-keys) + (let ((recutils (assoc-ref inputs "recutils"))) + ;; Specify the absolute file names of the various + ;; programs so that everything works out-of-the-box. + (substitute* "helm-system-packages-guix.el" + (("recsel") (string-append recutils "/bin/recsel"))))))))) + (home-page "https://github.com/emacs-helm/helm-system-packages") + (synopsis "Helm System Packages is an interface to your package manager") + (description "List all available packages in Helm (with installed +packages displayed in their own respective face). Fuzzy-search, mark and +execute the desired action over any selections of packages: Install, +uninstall, display packages details (in Org Mode) or insert details at point, +find files owned by packages... And much more, including performing all the +above over the network.") + (license license:gpl3+))) + +(define-public emacs-memoize + (package + (name "emacs-memoize") + (version "1.1") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/skeeto/emacs-memoize/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "05ijgwi4ymxx31vpjm2pn356j85cykknajn14lrzz8pn5sh0vrg4")))) + (build-system emacs-build-system) + (arguments + `(#:tests? #t + #:test-command '("emacs" "--batch" + "-l" "memoize-test.el" + "-f" "ert-run-tests-batch-and-exit"))) + (home-page "https://github.com/skeeto/emacs-memoize") + (synopsis "Emacs lisp memoization library") + (description "@code{emacs-memoize} is an Emacs library for +memoizing functions.") + (license license:unlicense))) + +(define-public emacs-linum-relative + (package + (name "emacs-linum-relative") + (version "0.5") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/coldnew/linum-relative/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0s4frvr27866lw1rn3jal9wj5rkz9fx4yiszqv7w06azsdgsqksv")))) + (build-system emacs-build-system) + (home-page "https://github.com/coldnew/linum-relative") + (synopsis "Relative line numbering for Emacs") + (description "@code{emacs-linum-relative} displays the relative line +number on the left margin in Emacs.") + (license license:gpl2+))) + +(define-public emacs-idle-highlight + (package + (name "emacs-idle-highlight") + (version "1.1.3") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/nonsequitur/idle-highlight-mode/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0kdv10hrgqpskjh0zvpnzwlkn5bccnqxas62gkws6njln57bf8nl")))) + (build-system emacs-build-system) + (home-page "https://www.emacswiki.org/emacs/IdleHighlight") + (synopsis "Highlights all occurrences of the word the point is on") + (description + "This Emacs package provides @code{idle-highlight-mode} that sets + an idle timer to highlight all occurrences in the buffer of the word under + the point.") + (license license:gpl3+))) + +(define-public emacs-ox-twbs + (package + (name "emacs-ox-twbs") + (version "1.1.1") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/marsmining/ox-twbs/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1zaq8dczq5wijjk36114k2x3hfrqig3lyx6djril6wyk67vczyqs")))) + (build-system emacs-build-system) + (home-page "https://github.com/marsmining/ox-twbs") + (synopsis "Export org-mode docs as HTML compatible with Twitter Bootstrap") + (description + "This Emacs package outputs your org-mode docs with a simple, clean and +modern look. It implements a new HTML back-end for exporting org-mode docs as +HTML compatible with Twitter Bootstrap. By default, HTML is exported with +jQuery and Bootstrap resources included via osscdn.") + (license license:gpl3+))) + +(define-public emacs-highlight-sexp + (package + (name "emacs-highlight-sexp") + (version "1.0") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/daimrod/highlight-sexp/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0jwx87qkln1rg9wmv4qkgkml935fh2pkgrg5x4ca6n5dgb4q6rj1")))) + (build-system emacs-build-system) + (home-page "https://github.com/daimrod/highlight-sexp") + (synopsis "Minor mode that highlights the s-exp at the current position") + (description + "This Emacs package highlights the s-exp at the current position.") + (license license:gpl3+))) + +(define-public emacs-highlight-stages + (let ((commit "29cbc5b78261916da042ddb107420083da49b271") + (revision "1")) + (package + (name "emacs-highlight-stages") + (version (string-append "1.1.0" "-" revision "." (string-take commit 7))) + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/zk-phi/highlight-stages.git") + (commit commit))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "0r6nbcrr0dqpgm8dir8ahzjy7rw4nrac48byamzrq96r7ajlxlv0")) + (patches + (search-patches "emacs-highlight-stages-add-gexp.patch")))) + (build-system emacs-build-system) + (home-page "https://github.com/wigust/highlight-stages") + (synopsis "Minor mode that highlights (quasi-quoted) expressions") + (description "@code{highlight-stages} provides an Emacs minor mode that +highlights quasi-quoted expressions.") + (license license:gpl3+)))) + +(define-public emacspeak + (package + (name "emacspeak") + (version "48.0") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/tvraman/emacspeak/releases/download/" + version "/emacspeak-" version ".tar.bz2")) + (sha256 + (base32 + "07imi3hji06b3r7v7v59978q76s8a7ynmxwfc9j03pgnv965lpjy")))) + (build-system gnu-build-system) + (arguments + '(#:make-flags (list (string-append "prefix=" + (assoc-ref %outputs "out"))) + #:phases + (modify-phases %standard-phases + (replace 'configure + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (lisp (string-append out + "/share/emacs/site-lisp/emacspeak"))) + (setenv "SHELL" (which "sh")) + ;; Configure Emacspeak according to etc/install.org. + (invoke "make" "config")))) + (add-after 'build 'build-espeak + (lambda _ + (invoke "make" "espeak"))) + (replace 'install + (lambda* (#:key inputs outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (bin (string-append out "/bin")) + (lisp (string-append out "/share/emacs/site-lisp/emacspeak")) + (info (string-append out "/share/info")) + (emacs (string-append (assoc-ref inputs "emacs") + "/bin/emacs"))) + ;; According to etc/install.org, the Emacspeak directory should + ;; be copied to its installation destination. + (for-each + (lambda (file) + (copy-recursively file (string-append lisp "/" file))) + '("etc" "info" "js" "lisp" "media" "scapes" "servers" "sounds" + "stumpwm" "xsl")) + ;; Make sure emacspeak is loaded from the correct directory. + (substitute* "etc/emacspeak.sh" + (("exec FLAVOR.*") + (string-append "exec " emacs " -l " lisp + "/lisp/emacspeak-setup.el $CL_ALL"))) + ;; Install the convenient startup script. + (mkdir-p bin) + (copy-file "etc/emacspeak.sh" (string-append bin "/emacspeak"))) + #t)) + (add-after 'install 'wrap-program + (lambda* (#:key inputs outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (emacspeak (string-append out "/bin/emacspeak")) + (espeak (string-append (assoc-ref inputs "espeak") + "/bin/espeak"))) + ;; The environment variable DTK_PROGRAM tells emacspeak what + ;; program to use for speech. + (wrap-program emacspeak + `("DTK_PROGRAM" ":" prefix (,espeak))) + #t)))) + #:tests? #f)) ; no check target + (inputs + `(("emacs" ,emacs) + ("espeak" ,espeak) + ("perl" ,perl) + ("tcl" ,tcl) + ("tclx" ,tclx))) + (home-page "http://emacspeak.sourceforge.net") + (synopsis "Audio desktop interface for Emacs") + (description + "Emacspeak is a speech interface that allows visually impaired users to +interact independently and efficiently with the computer. Audio formatting +--a technique pioneered by AsTeR-- and full support for W3C's Aural CSS (ACSS) +allows Emacspeak to produce rich aural presentations of electronic information. +By seamlessly blending all aspects of the Internet such as Web-surfing and +messaging, Emacspeak speech-enables local and remote information via a +consistent and well-integrated user interface.") + (license license:gpl2+))) + +(define-public emacs-adaptive-wrap + (package + (name "emacs-adaptive-wrap") + (version "0.5.1") + (source (origin + (method url-fetch) + (uri (string-append + "http://elpa.gnu.org/packages/adaptive-wrap-" + version ".el")) + (sha256 + (base32 + "0qi7gjprcpywk2daivnlavwsx53hl5wcqvpxbwinvigg42vxh3ll")))) + (build-system emacs-build-system) + (home-page "http://elpa.gnu.org/packages/adaptive-wrap.html") + (synopsis "Smart line-wrapping with wrap-prefix") + (description + "This Emacs package provides the @code{adaptive-wrap-prefix-mode} +minor mode which sets the wrap-prefix property on the fly so that +single-long-line paragraphs get word-wrapped in a way similar to what +you'd get with @kbd{M-q} using @code{adaptive-fill-mode}, but without +actually changing the buffer's text.") + (license license:gpl3+))) + +(define-public emacs-diff-hl + (package + (name "emacs-diff-hl") + (version "1.8.5") + (source + (origin + (method url-fetch) + (uri (string-append "https://elpa.gnu.org/packages/diff-hl-" + version ".tar")) + (sha256 + (base32 + "1vxc7z7c2qs0mx7l5sa4sybi5qbzv0s79flj74p1ynw8dl3qxg3d")))) + (build-system emacs-build-system) + (home-page "https://github.com/dgutov/diff-hl") + (synopsis + "Highlight uncommitted changes using VC") + (description + "@code{diff-hl-mode} highlights uncommitted changes on the side of the +window (using the fringe, by default), allows you to jump between +the hunks and revert them selectively.") + (license license:gpl3+))) + +(define-public emacs-diminish + (package + (name "emacs-diminish") + (version "0.45") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/myrjola/diminish.el/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0i3629sv5cfrrb00hcnmaqzgs8mk36yasc1ax3ry1ga09nr6rkj9")))) + (build-system emacs-build-system) + (home-page "https://github.com/myrjola/diminish.el") + (synopsis "Diminish minor modes with no modeline display") + (description "@code{emacs-diminish} implements hiding or +abbreviation of the mode line displays (lighters) of minor modes.") + (license license:gpl2+))) + +(define-public emacs-use-package + (let ((commit "da8c9e2840343906e732f9699e43d35a1f06481d") + (revision "1")) + (package + (name "emacs-use-package") + (version (git-version "2.3" revision commit)) + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/jwiegley/use-package") + (commit commit))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "0jz38pbq1p9h85i6qcsh3sfzkd103y6mw3rg5zd14dxigp8ir3xz")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-diminish" ,emacs-diminish))) + (arguments + `(#:tests? #t + #:test-command '("emacs" "--batch" + "-l" "use-package-tests.el" + "-f" "ert-run-tests-batch-and-exit"))) + (home-page "https://github.com/jwiegley/use-package") + (synopsis "Declaration for simplifying your .emacs") + (description "The use-package macro allows you to isolate package +configuration in your @file{.emacs} file in a way that is both +performance-oriented and tidy.") + (license license:gpl2+)))) + +(define-public emacs-strace-mode + (let* ((commit "6a69b4b06db6797af56f33eda5cb28af94e59f11") + (revision "1")) + (package + (name "emacs-strace-mode") + (version (string-append "0.0.2-" revision "." (string-take commit 7))) + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/pkmoore/strace-mode") + (commit commit))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "1lbk2kzdznf2bkfazizfbimaxxzfzv00lrz1ran9dc2zqbc0bj9f")))) + (build-system emacs-build-system) + (home-page "https://github.com/pkmoore/strace-mode") + (synopsis "Emacs major mode to highlight strace outputs") + (description "@code{emacs-strace-mode} provides an Emacs major mode + highlighting strace outputs.") + (license license:gpl3+)))) + +(define-public emacs-default-encrypt + (package + (name "emacs-default-encrypt") + (version "4.3") + (source + (origin + (method url-fetch) + (uri (string-append + "https://www.informationelle-selbstbestimmung-im-internet.de" + "/emacs/jl-encrypt" version "/jl-encrypt.el")) + (file-name (string-append "jl-encrypt-" version ".el")) + (sha256 + (base32 + "16i3rlfp3jxlqvndn8idylhmczync3gwmy8a019v29vyr48rnnr0")))) + (build-system emacs-build-system) + (home-page "https://www.informationelle-selbstbestimmung-im-internet.de/Emacs.html") + (synopsis "Automatically encrypt or sign Gnus messages in Emacs") + (description + "DefaultEncrypt is designed to be used with Gnus in Emacs. It +automatically encrypts messages that you send (e.g., email) when public keys +for all recipients are available, and it protects you from accidentally +sending un-encrypted messages. It can also be configured to automatically +sign messages that you send. For details and instructions on how to use +DefaultEncrypt, please refer to the home page or read the comments in the +source file, @file{jl-encrypt.el}.") + (license license:gpl3+))) + +(define-public emacs-htmlize + (package + (name "emacs-htmlize") + (version "1.53") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/hniksic/emacs-htmlize/archive/release/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1lzaf9m1qr9dhw4nn53g6wszk2vqw95gpsbrc3y85bams4cn24ga")))) + (build-system emacs-build-system) + (home-page "https://github.com/hniksic/emacs-htmlize") + (synopsis "Convert buffer text and decorations to HTML") + (description "@code{emacs-htmlize} converts the buffer text and +the associated decorations to HTML. Output to CSS, inline CSS and +fonts is supported.") + (license license:gpl2+))) + +(define-public emacs-xmlgen + (package + (name "emacs-xmlgen") + (version "0.5") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/philjackson/xmlgen/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0zay490vjby3f7455r0vydmjg7q1gwc78hilpfb0rg4gwz224z8r")))) + (build-system emacs-build-system) + (arguments + `(#:tests? #t + #:test-command '("emacs" "--batch" + "-l" "xmlgen-test.el" + "-f" "ert-run-tests-batch-and-exit"))) + (home-page "https://github.com/philjackson/xmlgen") + (synopsis "S-expression to XML domain specific language (DSL) in +Emacs Lisp") + (description "@code{emacs-xmlgen} provides S-expression to XML +conversion for Emacs Lisp.") + (license license:gpl2+))) + +(define-public emacs-cdlatex + (package + (name "emacs-cdlatex") + (version "4.7") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/cdominik/cdlatex/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0pivapphmykc6vhvpx7hdyl55ls37vc4jcrxpvs4yk7jzcmwa9xp")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-auctex" ,emacs-auctex))) + (home-page "https://github.com/cdominik/cdlatex") + (synopsis "Fast Emacs input methods for LaTeX environments and +math") + (description "CDLaTeX is an Emacs minor mode supporting fast +insertion of environment templates and math in LaTeX. Similar +commands are also offered as part of the AUCTeX package, but it is not +the same - CDLaTeX focuses on speediness for inserting LaTeX +constructs.") + (license license:gpl3+))) + +(define-public emacs-cnfonts + (package + (name "emacs-cnfonts") + (version "0.9.1") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/tumashu/cnfonts/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1l6cgcvc6md1zq97ccczankpyi0k4vjx6apflny6kjq3p33lyhf4")))) + (build-system emacs-build-system) + (home-page "https://github.com/tumashu/cnfonts") + (synopsis "Emacs Chinese fonts setup tool") + (description "cnfonts is a Chinese fonts setup tool, allowing for easy +configuration of Chinese fonts.") + (license license:gpl2+))) + +(define-public emacs-php-mode + (package + (name "emacs-php-mode") + (version "20171225.342") + (source (origin + (method url-fetch) + (uri (string-append + "https://melpa.org/packages/php-mode-" + version ".tar")) + (sha256 + (base32 + "1zz682f34v4wsm2dyj1gnrnvsrqdq1cy7j8p6cvc398w2fziyg3q")))) + (build-system emacs-build-system) + (home-page "https://github.com/ejmr/php-mode") + (synopsis "Major mode for editing PHP code") + (description "@code{php-mode} is a major mode for editing PHP source +code. It's an extension of C mode; thus it inherits all C mode's navigation +functionality. But it colors according to the PHP grammar and indents +according to the PEAR coding guidelines. It also includes a couple handy +IDE-type features such as documentation search and a source and class +browser.") + (license license:gpl3+))) + +(define-public emacs-pos-tip + (package + (name "emacs-pos-tip") + (version "0.4.6") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/pitkali/pos-tip/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "12jqfy26vjk7lq0aa8yn8zqj8c85fkvx7y9prj0pcn4wqiz2ad2r")))) + (build-system emacs-build-system) + ;; The following functions and variables needed by emacs-pos-tip are + ;; not included in emacs-minimal: + ;; x-display-pixel-width, x-display-pixel-height, x-show-tip + (arguments `(#:emacs ,emacs)) + (home-page "https://github.com/pitkali/pos-tip") + (synopsis "Show tooltip at point") + (description "The standard library tooltip.el provides a function for +displaying a tooltip at the mouse position. However, locating a tooltip at an +arbitrary buffer position in a window is not easy. Pos-tip provides such a +function to be used by other frontend programs.") + (license license:gpl2+))) + +(define-public emacs-pyim-basedict + (package + (name "emacs-pyim-basedict") + (version "0.3.1") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/tumashu/pyim-basedict/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0nfgxviavkgrpyfsw60xsws4fk51fcmgl8fp6zf4ibqjjbp53n3n")))) + (build-system emacs-build-system) + (home-page "https://github.com/tumashu/pyim-basedict") + (synopsis "Input method dictionary of pyim") + (description "Pyim-basedict is the default pinyin input method dictionary, +containing words from the rime project.") + (license license:gpl2+))) + +(define-public emacs-pyim + (package + (name "emacs-pyim") + (version "1.8") + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/tumashu/pyim") + (commit (string-append "v" version)))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "16rma4cv7xgky0g3x4an27v30jdi6i1sqw43cl99zhkqvp43l3f9")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-async" ,emacs-async) + ("emacs-pyim-basedict" ,emacs-pyim-basedict) + ("emacs-popup" ,emacs-popup) + ("emacs-posframe" ,emacs-posframe))) + (home-page "https://github.com/tumashu/pyim") + (synopsis "Chinese input method") + (description "Chinese input method which supports quanpin, shuangpin, wubi +and cangjie.") + (license license:gpl2+))) + +(define-public emacs-posframe + (package + (name "emacs-posframe") + (version "0.4.2") + (source + (origin + (method url-fetch) + (uri (string-append + "https://elpa.gnu.org/packages/posframe-" version ".el")) + (sha256 + (base32 + "1h8vvxvsg41vc1nnglqjs2q0k1yzfsn72skga9s76qa3zxmx6kds")))) + (build-system emacs-build-system) + ;; emacs-minimal does not include the function font-info + (arguments `(#:emacs ,emacs)) + (home-page "https://github.com/tumashu/posframe") + (synopsis "Pop a posframe (a child frame) at point") + (description "@code{emacs-posframe} can pop a posframe at point. A +posframe is a child frame displayed within its root window's buffer. +@code{emacs-posframe} is fast and works well with CJK languages.") + (license license:gpl3+))) + +(define-public emacs-el2org + (package + (name "emacs-el2org") + (version "0.6.0") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/tumashu/el2org/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0gd3km1swwvg2w0kdi7370f54wgrflxn63gjgssfjc1iyc9sbqwq")))) + (build-system emacs-build-system) + (home-page "https://github.com/tumashu/el2org") + (synopsis "Convert Emacs-lisp file to org file") + (description "El2org is a simple tool, which can convert Emacs-lisp file +to org file, you can use this tool to write orgify commentary.") + (license license:gpl2+))) + +(define-public emacs-mustache + (package + (name "emacs-mustache") + (version "0.23") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/Wilfred/mustache.el/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0k9lcgil7kykkv1ylrgwy1g13ldjjmgi2cwmysgyb2vlj3jbwpdj")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-dash" ,emacs-dash) + ("emacs-ht" ,emacs-ht) + ("emacs-s" ,emacs-s))) + (home-page "https://github.com/Wilfred/mustache.el") + (synopsis "Mustache templating library for Emacs") + (description "Mustache templating library for Emacs, mustache is +a simple web template system, which is described as a logic-less system +because it lacks any explicit control flow statements, both looping and +conditional evaluation can be achieved using section tags processing lists +and lambdas.") + (license license:gpl3+))) + +(define-public emacs-org2web + (package + (name "emacs-org2web") + (version "0.9.1") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/tumashu/org2web/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1c0ixcphlhp4c4qdiwq40bc3yp1gp1llp8pxrk4s7ny9n68s52zp")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-dash" ,emacs-dash) + ("emacs-el2org" ,emacs-el2org) + ("emacs-ht" ,emacs-ht) + ("emacs-mustache" ,emacs-mustache) + ("emacs-simple-httpd" ,emacs-simple-httpd))) + (home-page "https://github.com/tumashu/org2web") + (synopsis "Static site generator based on org-mode ") + (description "Org2web is a static site generator based on org-mode, +which code derived from Kelvin H's org-page.") + (license license:gpl2+))) + +(define-public emacs-xelb + (package + (name "emacs-xelb") + (version "0.16") + (source (origin + (method url-fetch) + (uri (string-append "https://elpa.gnu.org/packages/xelb-" + version ".tar")) + (sha256 + (base32 + "03wsr1jr7f7zfd80h864rd4makwh4widdnj1kjv2xyjwdgap9rl8")))) + (build-system emacs-build-system) + ;; The following functions and variables needed by emacs-xelb are + ;; not included in emacs-minimal: + ;; x-display-screens, x-keysym-table, x-alt-keysym, x-meta-keysym + ;; x-hyper-keysym, x-super-keysym, libxml-parse-xml-region + ;; x-display-pixel-width, x-display-pixel-height + (arguments + `(#:emacs ,emacs + #:phases + (modify-phases %standard-phases + (add-after 'unpack 'regenerate-el-files + (lambda* (#:key inputs #:allow-other-keys) + (invoke "make" + (string-append "PROTO_PATH=" + (assoc-ref inputs "xcb-proto") + "/share/xcb") + (string-append "EMACS_BIN=" + (assoc-ref inputs "emacs") + "/bin/emacs -Q"))))))) + (native-inputs `(("xcb-proto" ,xcb-proto))) + (home-page "https://github.com/ch11ng/xelb") + (synopsis "X protocol Emacs Lisp binding") + (description "@code{emacs-xelb} is a pure Emacs Lisp implementation of the +X11 protocol based on the XML description files from the XCB project. It +features an object-oriented API and permits a certain degree of concurrency. +It should enable you to implement low-level X11 applications.") + (license license:gpl3+))) + +(define-public emacs-exwm + (package + (name "emacs-exwm") + (version "0.21") + (synopsis "Emacs X window manager") + (source (origin + (method url-fetch) + (uri (string-append "https://elpa.gnu.org/packages/exwm-" + version ".tar")) + (sha256 + (base32 + "07ng1pgsnc3isfsyzh2gfc7391p9il8lb5xqf1z6yqn20w7k6xzj")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-xelb" ,emacs-xelb))) + (inputs + `(("xhost" ,xhost) + ("dbus" ,dbus))) + ;; The following functions and variables needed by emacs-exwm are + ;; not included in emacs-minimal: + ;; scroll-bar-mode, fringe-mode + ;; x-display-pixel-width, x-display-pixel-height + (arguments + `(#:emacs ,emacs + #:phases + (modify-phases %standard-phases + (add-after 'build 'install-xsession + (lambda* (#:key inputs outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (xsessions (string-append out "/share/xsessions")) + (bin (string-append out "/bin")) + (exwm-executable (string-append bin "/exwm"))) + ;; Add a .desktop file to xsessions + (mkdir-p xsessions) + (mkdir-p bin) + (with-output-to-file + (string-append xsessions "/exwm.desktop") + (lambda _ + (format #t "[Desktop Entry]~@ + Name=~a~@ + Comment=~a~@ + Exec=~a~@ + TryExec=~@*~a~@ + Type=Application~%" ,name ,synopsis exwm-executable))) + ;; Add a shell wrapper to bin + (with-output-to-file exwm-executable + (lambda _ + (format #t "#!~a ~@ + ~a +SI:localuser:$USER ~@ + exec ~a --exit-with-session ~a \"$@\" --eval '~s' ~%" + (string-append (assoc-ref inputs "bash") "/bin/sh") + (string-append (assoc-ref inputs "xhost") "/bin/xhost") + (string-append (assoc-ref inputs "dbus") "/bin/dbus-launch") + (string-append (assoc-ref inputs "emacs") "/bin/emacs") + '(cond + ((file-exists-p "~/.exwm") + (load-file "~/.exwm")) + ((not (featurep 'exwm)) + (require 'exwm) + (require 'exwm-config) + (exwm-config-default) + (message (concat "exwm configuration not found. " + "Falling back to default configuration..."))))))) + (chmod exwm-executable #o555) + #t)))))) + (home-page "https://github.com/ch11ng/exwm") + (description "EXWM is a full-featured tiling X window manager for Emacs +built on top of XELB.") + (license license:gpl3+))) + +(define-public emacs-switch-window + (package + (name "emacs-switch-window") + (version "1.6.2") + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/dimitri/switch-window") + (commit (string-append "v" version)))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "0rci96asgamr6qp6nkyr5vwrnslswjxcjd96yccy4aivh0g66yfg")))) + (build-system emacs-build-system) + (home-page "https://github.com/dimitri/switch-window") + (synopsis "Emacs window switch tool") + (description "Switch-window is an emacs window switch tool, which +offer a visual way to choose a window to switch to, delete, split or +other operations.") + (license license:wtfpl2))) + +(define-public emacs-exwm-x + (package + (name "emacs-exwm-x") + (version "1.9.0") + (synopsis "Derivative window manager based on EXWM") + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/tumashu/exwm-x") + (commit (string-append "v" version)))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "03l3dl7s1qys1kkh40rm1sfx7axy1b8sf5f6nyksj9ps6d30p5i4")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-exwm" ,emacs-exwm) + ("emacs-switch-window" ,emacs-switch-window) + ("emacs-ivy" ,emacs-ivy) + ("emacs-use-package" ,emacs-use-package))) + (inputs + `(("xhost" ,xhost) + ("dbus" ,dbus))) + ;; Need emacs instead of emacs-minimal, + ;; for emacs's bin path will be inserted into bin/exwm-x file. + (arguments + `(#:emacs ,emacs + #:phases + (modify-phases %standard-phases + (add-after 'build 'install-xsession + (lambda* (#:key inputs outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (xsessions (string-append out "/share/xsessions")) + (bin (string-append out "/bin")) + (exwm-executable (string-append bin "/exwm-x"))) + ;; Add a .desktop file to xsessions + (mkdir-p xsessions) + (mkdir-p bin) + (with-output-to-file + (string-append xsessions "/exwm-x.desktop") + (lambda _ + (format #t "[Desktop Entry]~@ + Name=~a~@ + Comment=~a~@ + Exec=~a~@ + TryExec=~@*~a~@ + Type=Application~%" ,name ,synopsis exwm-executable))) + ;; Add a shell wrapper to bin + (with-output-to-file exwm-executable + (lambda _ + (format #t "#!~a ~@ + ~a +SI:localuser:$USER ~@ + exec ~a --exit-with-session ~a \"$@\" --eval '~s' ~%" + (string-append (assoc-ref inputs "bash") "/bin/sh") + (string-append (assoc-ref inputs "xhost") "/bin/xhost") + (string-append (assoc-ref inputs "dbus") "/bin/dbus-launch") + (string-append (assoc-ref inputs "emacs") "/bin/emacs") + '(require 'exwmx-loader)))) + (chmod exwm-executable #o555) + #t)))))) + (home-page "https://github.com/tumashu/exwm-x") + (description "EXWM-X is a derivative window manager based on EXWM, with focus +on mouse-control.") + (license license:gpl3+))) + +(define-public emacs-gnuplot + (package + (name "emacs-gnuplot") + (version "0.7.0") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/bruceravel/gnuplot-mode/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0glzymrn138lwig7p4cj17x4if5jisr6l4g6wcbxisqkqgc1h01i")))) + (build-system gnu-build-system) + (native-inputs `(("emacs" ,emacs-minimal))) + (arguments + (let ((elisp-dir (string-append "/share/emacs/site-lisp/guix.d" + "/gnuplot-" version))) + `(#:modules ((guix build gnu-build-system) + (guix build utils) + (guix build emacs-utils)) + #:imported-modules (,@%gnu-build-system-modules + (guix build emacs-utils)) + #:configure-flags + (list (string-append "EMACS=" (assoc-ref %build-inputs "emacs") + "/bin/emacs") + (string-append "--with-lispdir=" %output ,elisp-dir)) + #:phases + (modify-phases %standard-phases + (add-after 'install 'generate-autoloads + (lambda* (#:key outputs #:allow-other-keys) + (emacs-generate-autoloads + "gnuplot" + (string-append (assoc-ref outputs "out") ,elisp-dir)) + #t)))))) + (home-page "https://github.com/bruceravel/gnuplot-mode") + (synopsis "Emacs major mode for interacting with gnuplot") + (description "@code{emacs-gnuplot} is an emacs major mode for interacting +with gnuplot.") + (license license:gpl2+))) + +(define-public emacs-transpose-frame + (package + (name "emacs-transpose-frame") + (version "0.1.0") + (source + (origin + (method url-fetch) + (uri "http://www.emacswiki.org/emacs/download/transpose-frame.el") + (file-name (string-append "transpose-frame-" version ".el")) + (sha256 + (base32 + "1f67yksgw9s6j0033hmqzaxx2a93jm11sd5ys7cc3li5gfh680m4")))) + (build-system emacs-build-system) + (home-page "https://www.emacswiki.org/emacs/TransposeFrame") + (synopsis "Transpose window arrangement in current frame") + (description "@code{emacs-transpose-frame} provides some interactive +functions which allows users to transpose windows arrangement in currently +selected frame.") + (license license:bsd-2))) + +(define-public emacs-key-chord + (package + (name "emacs-key-chord") + (version "0.6") + (source + (origin + (method url-fetch) + (uri "https://www.emacswiki.org/emacs/download/key-chord.el") + (file-name (string-append "key-chord-" version ".el")) + (sha256 + (base32 + "03m44pqggfrd53nh9dvpdjgm0rvca34qxmd30hr33hzprzjambxg")))) + (build-system emacs-build-system) + (home-page "https://www.emacswiki.org/emacs/key-chord.el") + (synopsis "Map pairs of simultaneously pressed keys to Emacs commands") + (description "@code{emacs-key-chord} provides @code{key-chord-mode}, a +mode for binding key chords to commands. A key chord is defined as two keys +pressed simultaneously or a single key quickly pressed twice.") + (license license:gpl2+))) + +(define-public emacs-evil-surround + (package + (name "emacs-evil-surround") + (version "1.0.0") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/timcharper/evil-surround/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0p572jgic3q1ia1nz37kclir729ay6i2f4sa7wnaapyxly2lwb3r")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-evil" ,emacs-evil))) + (home-page "https://github.com/timcharper/evil-surround") + (synopsis "Easily modify surrounding parantheses and quotes") + (description "@code{emacs-evil-surround} allows easy deletion, change and +addition of surrounding pairs, such as parantheses and quotes, in evil mode.") + (license license:gpl3+))) + +(define-public emacs-evil-commentary + (package + (name "emacs-evil-commentary") + (version "2.1.1") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/linktohack/evil-commentary/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1jdya0i921nwskwrzdsj0vrr3m7gm49dy6f6pk9p5nxaarfxk230")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-evil" ,emacs-evil))) + (home-page "https://github.com/linktohack/evil-commentary") + (synopsis "Comment out code in evil mode") + (description "@code{emacs-evil-commentary} adds keybindings to easily +comment out lines of code in evil mode. It provides @code{gcc} to comment out +lines, and @code{gc} to comment out the target of a motion.") + (license license:gpl3+))) + +;; Tests for emacs-ansi have a circular dependency with ert-runner, and +;; therefore cannot be run +(define-public emacs-ansi + (package + (name "emacs-ansi") + (version "0.4.1") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/rejeep/ansi.el/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "13jj4vbi98j3p17hs99bmy7g21jd5h4v3wpxk4pkvhylm3bfwjw8")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-dash" ,emacs-dash) + ("emacs-s" ,emacs-s))) + (home-page "https://github.com/rejeep/ansi.el") + (synopsis "Convert strings to ANSI") + (description "@code{emacs-ansi} defines functions that turns simple +strings to ANSI strings. Turning a string into an ANSI string can be to add +color to a text, add color in the background of a text or adding a style, such +as bold, underscore or italic.") + (license license:gpl3+))) + +;; Tests for emacs-commander have a circular dependency with ert-runner, and +;; therefore cannot be run +(define-public emacs-commander + (package + (name "emacs-commander") + (version "0.7.0") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/rejeep/commander.el/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "196s2i15z7gwxa97l1wkxvjnfmj5n38wwm6d3g4zz15l2vqggc2y")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-dash" ,emacs-dash) + ("emacs-f" ,emacs-f) + ("emacs-s" ,emacs-s))) + (home-page "https://github.com/rejeep/commander.el") + (synopsis "Emacs command line parser") + (description "@code{emacs-commander} provides command line parsing for +Emacs.") + (license license:gpl3+))) + +;; Tests for ert-runner have a circular dependency with ecukes, and therefore +;; cannot be run +(define-public emacs-ert-runner + (package + (name "emacs-ert-runner") + (version "0.7.0") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/rejeep/ert-runner.el/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1657nck9i96a4xgl8crfqq0s8gflzp21pkkzwg6m3z5npjxklgwp")))) + (build-system emacs-build-system) + (inputs + `(("emacs-ansi" ,emacs-ansi) + ("emacs-commander" ,emacs-commander) + ("emacs-dash" ,emacs-dash) + ("emacs-f" ,emacs-f) + ("emacs-s" ,emacs-s) + ("emacs-shut-up" ,emacs-shut-up))) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-after 'install 'install-executable + (lambda* (#:key inputs outputs #:allow-other-keys) + (let ((out (assoc-ref outputs "out"))) + (substitute* "bin/ert-runner" + (("ERT_RUNNER=\"\\$\\(dirname \\$\\(dirname \\$0\\)\\)") + (string-append "ERT_RUNNER=\"" out + "/share/emacs/site-lisp/guix.d/ert-runner-" + ,version))) + (install-file "bin/ert-runner" (string-append out "/bin")) + (wrap-program (string-append out "/bin/ert-runner") + (list "EMACSLOADPATH" ":" 'prefix + (string-split (getenv "EMACSLOADPATH") #\:))) + #t)))) + #:include (cons* "^reporters/.*\\.el$" %default-include))) + (home-page "https://github.com/rejeep/ert-runner.el") + (synopsis "Opinionated Ert testing workflow") + (description "@code{ert-runner} is a tool for Emacs projects tested +using ERT. It assumes a certain test structure setup and can therefore make +running tests easier.") + (license license:gpl3+))) + +(define-public ert-runner + (deprecated-package "ert-runner" emacs-ert-runner)) + +(define-public emacs-disable-mouse + (package + (name "emacs-disable-mouse") + (version "0.2") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/purcell/disable-mouse/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0haqpq23r1wx04lsqrrg3p5visg9hx5i36dg55ab003wfsrlrzbc")))) + (build-system emacs-build-system) + (home-page "https://github.com/purcell/disable-mouse") + (synopsis "Disable mouse commands globally") + (description + "Provides @code{disable-mouse-mode} and @code{global-disable-mouse-mode}, +pair of minor modes which suppress all mouse events by intercepting them and +running a customisable handler command (@code{ignore} by default). ") + (license license:gpl3+))) + +(define-public emacs-json-reformat + (package + (name "emacs-json-reformat") + (version "0.0.6") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/gongo/json-reformat/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "11fbq4scrgr7m0iwnzcrn2g7xvqwm2gf82sa7zy1l0nil7265p28")) + (patches (search-patches "emacs-json-reformat-fix-tests.patch")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-undercover" ,emacs-undercover))) + (native-inputs + `(("emacs-dash" ,emacs-dash) + ("emacs-shut-up" ,emacs-shut-up) + ("ert-runner" ,emacs-ert-runner))) + (arguments + `(#:tests? #t + #:test-command '("ert-runner"))) + (home-page "https://github.com/gongo/json-reformat") + (synopsis "Reformatting tool for JSON") + (description "@code{json-reformat} provides a reformatting tool for +@url{http://json.org/, JSON}.") + (license license:gpl3+))) + +(define-public emacs-json-snatcher + (package + (name "emacs-json-snatcher") + (version "1.0.0") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/Sterlingg/json-snatcher/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1nfiwsifpdiz0lbrqa77nl0crnfrv5h85ans9b0g5rggnmyshcfb")))) + (build-system emacs-build-system) + (home-page "https://github.com/sterlingg/json-snatcher") + (synopsis "Grabs the path to JSON values in a JSON file") + (description "@code{emacs-json-snatcher} grabs the path to JSON values in +a @url{http://json.org/, JSON} file.") + (license license:gpl3+))) + +(define-public emacs-json-mode + (package + (name "emacs-json-mode") + (version "1.7.0") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/joshwnj/json-mode/archive/" + "v" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "06h45p4cn767pk9sqi2zb1c65wy5gyyijqxzpglp80zwxhvajdz5")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-json-reformat" ,emacs-json-reformat) + ("emacs-json-snatcher" ,emacs-json-snatcher))) + (home-page "https://github.com/joshwnj/json-mode") + (synopsis "Major mode for editing JSON files") + (description "@code{json-mode} extends the builtin js-mode syntax +highlighting.") + (license license:gpl3+))) + +(define-public emacs-restclient + (let ((commit "07a3888bb36d0e29608142ebe743b4362b800f40") + (revision "1")) ;Guix package revision, + ;upstream doesn't have official releases + (package + (name "emacs-restclient") + (version (string-append revision "." + (string-take commit 7))) + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/pashky/restclient.el.git") + (commit commit))) + (sha256 + (base32 + "00lmjhb5im1kgrp54yipf1h9pshxzgjlg71yf2rq5n973gvb0w0q")) + (file-name (git-file-name name version)))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-helm" ,emacs-helm))) + (home-page "https://github.com/pashky/restclient.el") + (synopsis "Explore and test HTTP REST webservices") + (description + "This tool allows for testing and exploration of HTTP REST Web services +from within Emacs. Restclient runs queries from a plan-text query sheet, +displays results pretty-printed in XML or JSON with @code{restclient-mode}") + (license license:public-domain)))) + +(define-public emacs-eimp + (let ((version "1.4.0") + (commit "2e7536fe6d8f7faf1bad7a8ae37faba0162c3b4f") + (revision "1")) + (package + (name "emacs-eimp") + (version (git-version version revision commit)) + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/nicferrier/eimp.git") + (commit commit))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "154d57yafxbcf39r89n5j43c86rp2fki3lw3gwy7ww2g6qkclcra")))) + (build-system emacs-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-after 'unpack 'configure + (lambda* (#:key inputs #:allow-other-keys) + (let ((imagemagick (assoc-ref inputs "imagemagick"))) + ;; eimp.el is read-only in git. + (chmod "eimp.el" #o644) + (emacs-substitute-variables "eimp.el" + ("eimp-mogrify-program" + (string-append imagemagick "/bin/mogrify")))) + #t))))) + (inputs + `(("imagemagick" ,imagemagick))) + (home-page "https://github.com/nicferrier/eimp") + (synopsis "Interactive image manipulation utility for Emacs") + (description "@code{emacs-eimp} allows interactive image manipulation +from within Emacs. It uses the code@{mogrify} utility from ImageMagick to do +the actual transformations.") + (license license:gpl2+)))) + +(define-public emacs-dired-hacks + (let ((commit "eda68006ce73bbf6b9b995bfd70d08bec8cade36") + (revision "1")) + (package + (name "emacs-dired-hacks") + (version (string-append "0.0.1-" revision "." + (string-take commit 7))) + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/Fuco1/dired-hacks.git") + (commit commit))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "1w7ssl9zssn5rcha6apf4h8drkd02k4xgvs203bdbqyqp9wz9brx")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-dash" ,emacs-dash) + ("emacs-eimp" ,emacs-eimp) + ("emacs-f" ,emacs-f) + ("emacs-s" ,emacs-s))) + (home-page "https://github.com/Fuco1/dired-hacks") + (synopsis + "Collection of useful dired additions") + (description + "Collection of Emacs dired mode additions: +@itemize +@item dired-avfs +@item dired-columns +@item dired-filter +@item dired-hacks-utils +@item dired-images +@item dired-list +@item dired-narrow +@item dired-open +@item dired-rainbow +@item dired-ranger +@item dired-subtree +@item dired-tagsistant +@end itemize\n") + (license license:gpl3+)))) + +(define-public emacs-dired-sidebar + (let ((commit "06bd0d40bab812c61a668129daf29ba359424454") + (revision "0")) + (package + (name "emacs-dired-sidebar") + (home-page "https://github.com/jojojames/dired-sidebar") + (version (git-version "0.0.1" revision commit)) + (source (origin + (method git-fetch) + (uri (git-reference (url home-page) (commit commit))) + (sha256 + (base32 + "0lvwvq6sl80sha9fq5m4568sg534dhmifyjqw75bqddcbf3by84x")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-dired-subtree" ,emacs-dired-hacks))) + (synopsis "Sidebar for Emacs using Dired") + (description + "This package provides a sidebar for Emacs similar to @code{NeoTree} +or @code{treemacs}, but leveraging @code{Dired} to do the job of display.") + (license license:gpl3+)))) + +(define-public emacs-which-key + (package + (name "emacs-which-key") + (version "3.3.0") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/justbur/emacs-which-key/archive/v" + version ".tar.gz")) + (sha256 + (base32 + "1lsj314111cp2hjjwnv3f46ws1za6bm39rgy3l19044xf6a68j5w")) + (file-name (string-append name "-" version ".tar.gz")))) + (build-system emacs-build-system) + (arguments + `(#:tests? #t + #:test-command '("emacs" "--batch" + "-l" "which-key-tests.el" + "-f" "ert-run-tests-batch-and-exit"))) + (home-page "https://github.com/justbur/emacs-which-key") + (synopsis "Display available key bindings in popup") + (description + "@code{emacs-which-key} is a minor mode for Emacs that displays the key +bindings following your currently entered incomplete command (a prefix) in a +popup. For example, after enabling the minor mode if you enter C-x and wait +for the default of 1 second, the minibuffer will expand with all of the +available key bindings that follow C-x (or as many as space allows given your +settings).") + (license license:gpl3+))) + +(define-public emacs-ws-butler + (package + (name "emacs-ws-butler") + (version "0.6") + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/lewang/ws-butler.git") + (commit "323b651dd70ee40a25accc940b8f80c3a3185205"))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "1a4b0lsmwq84qfx51c5xy4fryhb1ysld4fhgw2vr37izf53379sb")))) + (build-system emacs-build-system) + (native-inputs + `(("ert-runner" ,emacs-ert-runner))) + (arguments + `(#:tests? #t + #:test-command '("ert-runner" "tests"))) + (home-page "https://github.com/lewang/ws-butler") + (synopsis "Trim spaces from end of lines") + (description + "This Emacs package automatically and unobtrusively trims whitespace +characters from end of lines.") + (license license:gpl3+))) + +(define-public emacs-org-edit-latex + (package + (name "emacs-org-edit-latex") + (version "0.8.0") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/et2010/org-edit-latex/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1y4h6wrs8286h9pbsv4d8fr67a885vz8b2k80qgv5qddipi2i78p")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-auctex" ,emacs-auctex) + ;; The version of org in Emacs 25.2 is not sufficient, because the + ;; `org-latex-make-preamble' function is required. + ("emacs-org" ,emacs-org))) + (home-page "https://github.com/et2010/org-edit-latex") + (synopsis "Edit a latex fragment just like editing a src block") + (description "@code{emacs-org-edit-latex} is an extension for org-mode. +It lets you edit a latex fragment in a dedicated buffer just like editing a +src block.") + (license license:gpl3+))) + +(define-public emacs-emamux + (package + (name "emacs-emamux") + (version "0.14") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/syohex/emacs-emamux/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0wlqg4icy037bj70b0qmhvwvmiwhagpnx6pnxhq6gzy1hvwlilkx")))) + (build-system emacs-build-system) + (home-page "https://github.com/syohex/emacs-emamux") + (synopsis "Manipulate Tmux from Emacs") + (description + "@code{emacs-emamux} lets Emacs interact with the @code{tmux} terminal +multiplexer.") + (license license:gpl3+))) + +(define-public emacs-rpm-spec-mode + (package + (name "emacs-rpm-spec-mode") + (version "0.16") + (source + (origin + (method url-fetch) + ;; URI has the Fedora release number instead of the version + ;; number. This will have to updated manually every new release. + (uri (string-append + "https://src.fedoraproject.org/cgit/rpms" + "/emacs-rpm-spec-mode.git/snapshot" + "/emacs-rpm-spec-mode-f26.tar.gz")) + (sha256 + (base32 + "17dz80lhjrc89fj17pysl8slahzrqdkxgcjdk55zls6jizkr6kz3")))) + (build-system emacs-build-system) + (home-page "http://pkgs.fedoraproject.org/cgit/rpms/emacs-rpm-spec-mode.git") + (synopsis "Emacs major mode for editing RPM spec files") + (description "@code{emacs-rpm-spec-mode} provides an Emacs major mode for +editing RPM spec files.") + (license license:gpl2+))) + +(define-public emacs-git-messenger + (package + (name "emacs-git-messenger") + (version "0.18") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/syohex/emacs-git-messenger/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "17mqki6g0wx46fn7dcbcc2pjxik7vvrcb1j9jzxim8b9psbsbnp9")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-popup" ,emacs-popup))) + (arguments + `(#:tests? #t + #:test-command '("emacs" "--batch" "-l" "test/test.el" + "-f" "ert-run-tests-batch-and-exit"))) + (home-page "https://github.com/syohex/emacs-git-messenger") + (synopsis "Popup commit message at current line") + (description "@code{emacs-git-messenger} provides +@code{git-messenger:popup-message}, a function that when called, will popup +the last git commit message for the current line. This uses git-blame +internally.") + (license license:gpl3+))) + +(define-public emacs-gitpatch + (package + (name "emacs-gitpatch") + (version "0.5.0") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/tumashu/gitpatch/archive/" + "v" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1yj6pmic541lcnscjin300k380qp9xdfprs55xg1q57jrkq6f6k7")))) + (build-system emacs-build-system) + (home-page "https://github.com/tumashu/gitpatch") + (synopsis "Mail git patch from Emacs") + (description "@code{emacs-gitpatch} lets users easily send git patches, +created by @code{git format-patch}, from @code{magit}, @code{dired} and +@code{ibuffer} buffers.") + (license license:gpl3+))) + +(define-public emacs-erc-hl-nicks + (package + (name "emacs-erc-hl-nicks") + (version "1.3.3") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/leathekd/erc-hl-nicks" + "/archive/" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1a1r2kc3688g8c2ybkpwh88kgmnqhg3h3032g2yn4zr9m0n3vpkr")))) + (build-system emacs-build-system) + (synopsis "Nickname highlighting for Emacs ERC") + (description "@code{erc-hl-nicks} highlights nicknames in ERC, an IRC +client for Emacs. The main features are: +@itemize +@item Auto-colorizes nicknames without having to specify colors +@item Ignores certain characters that IRC clients add to nicknames to avoid +duplicates (nickname, nickname’, nickname\", etc.) +@item Attempts to produce colors with a sufficient amount of contrast between +the nick color and the background color +@end itemize\n") + (home-page "https://github.com/leathekd/erc-hl-nicks") + (license license:gpl3+))) + +(define-public emacs-engine-mode + (package + (name "emacs-engine-mode") + (version "2.0.0") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/hrs/engine-mode/archive/" + "v" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1vm4p7pcp1vnwwxvps1bhm7i7hkabqqxl898knxf2hqvxys76684")))) + (build-system emacs-build-system) + (synopsis "Minor mode for defining and querying search engines") + (description "@code{engine-mode} is a global minor mode for Emacs. It +enables you to easily define search engines, bind them to keybindings, and +query them from the comfort of your editor.") + (home-page "https://github.com/hrs/engine-mode") + (license license:gpl3+))) + +(define-public emacs-prop-menu + (package + (name "emacs-prop-menu") + (version "0.1.2") + (source + (origin + (method url-fetch) + (uri (string-append + "http://stable.melpa.org/packages/prop-menu-" + version ".el")) + (sha256 + (base32 + "01bk4sjafzz7gqrkv9jg0pa85qr34vbk3q8ga2b0m61bndywzgpr")))) + (build-system emacs-build-system) + (home-page + "https://github.com/david-christiansen/prop-menu-el") + (synopsis + "Create and display a context menu based on text and overlay properties") + (description + "This is a library for computing context menus based on text +properties and overlays. The intended use is to have tools that +annotate source code and others that use these annotations, without +requiring a direct coupling between them, but maintaining +discoverability. + +Major modes that wish to use this library should first define an +appropriate value for @code{prop-menu-item-functions}. Then, they should +bind @code{prop-menu-by-completing-read} to an appropriate +key. Optionally, a mouse pop-up can be added by binding +@code{prop-menu-show-menu} to a mouse event.") + (license license:gpl3+))) + +(define-public emacs-idris-mode + (package + (name "emacs-idris-mode") + (version "0.9.19") + (source + (origin + (method url-fetch) + (uri (string-append + "http://stable.melpa.org/packages/idris-mode-" + version ".tar")) + (sha256 + (base32 + "02r1qqsxi6qk7q4cj6a6pygbj856dcw9vcmhfh0ib92j41v77q6y")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-prop-menu" ,emacs-prop-menu))) + (home-page + "https://github.com/idris-hackers/idris-mode") + (synopsis "Major mode for editing Idris code") + (description + "This is an Emacs mode for editing Idris code. It requires the latest +version of Idris, and some features may rely on the latest Git version of +Idris.") + (license license:gpl3+))) + +(define-public emacs-browse-at-remote + (package + (name "emacs-browse-at-remote") + (version "0.10.0") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/rmuslimov/browse-at-remote/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0ymslsp6i1naw25zckv25bf4aaq6qwkbkn95qyzlwg869l802686")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-f" ,emacs-f) + ("emacs-s" ,emacs-s))) + (native-inputs + `(("ert-runner" ,emacs-ert-runner))) + (arguments + `(#:tests? #t + #:test-command '("ert-runner"))) + (home-page "https://github.com/rmuslimov/browse-at-remote") + (synopsis "Open github/gitlab/bitbucket/stash page from Emacs") + (description + "This Emacs package allows you to open a target page on +github/gitlab (or bitbucket) by calling @code{browse-at-remote} command. +It supports dired buffers and opens them in tree mode at destination.") + (license license:gpl3+))) + +(define-public emacs-tiny + (package + (name "emacs-tiny") + (version "0.2.1") + (source + (origin + (method url-fetch) + (uri (string-append "http://elpa.gnu.org/packages/tiny-" version ".tar")) + (sha256 + (base32 + "1cr73a8gba549ja55x0c2s554f3zywf69zbnd7v82jz5q1k9wd2v")))) + (build-system emacs-build-system) + (home-page "https://github.com/abo-abo/tiny") + (synopsis "Quickly generate linear ranges in Emacs") + (description + "The main command of the @code{tiny} extension for Emacs is @code{tiny-expand}. +It is meant to quickly generate linear ranges, e.g. 5, 6, 7, 8. Some elisp +proficiency is an advantage, since you can transform your numeric range with +an elisp expression.") + (license license:gpl3+))) + +(define-public emacs-emojify + (package + (name "emacs-emojify") + (version "0.4") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/iqbalansari/emacs-emojify/" + "releases/download/v" version "/emojify-" + version ".tar")) + (sha256 + (base32 + "0k84v2d2bkiwcky9fi1yyprgkj46g7wh6pyl9gzmcd7sqv051d5n")))) + (build-system emacs-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-after 'install 'install-data + (lambda* (#:key outputs #:allow-other-keys) + (copy-recursively "data" + (string-append (assoc-ref outputs "out") + "/share/emacs/site-lisp/guix.d/" + "emojify-" ,version "/data")) + #t))))) + (propagated-inputs + `(("emacs-ht" ,emacs-ht))) + (home-page "https://github.com/iqbalansari/emacs-emojify") + (synopsis "Display emojis in Emacs") + (description "This package displays emojis in Emacs similar to how Github, +Slack, and other websites do. It can display plain ASCII like @code{:)} as +well as Github-style emojis like @code{:smile:}. It provides a minor mode +@code{emojify-mode} to enable the display of emojis in a buffer.") + (license license:gpl3+))) + +(define-public emacs-websocket + (package + (name "emacs-websocket") + (version "1.10") + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/ahyatt/emacs-websocket.git") + (commit version))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "1dgrf7na6r6mmkknphzshlbd5fnzisg0qn0j7vfpa38wgsymaq52")))) + (build-system emacs-build-system) + (home-page "http://elpa.gnu.org/packages/websocket.html") + (synopsis "Emacs WebSocket client and server") + (description "This is an Elisp library for WebSocket clients to talk to +WebSocket servers, and for WebSocket servers to accept connections from +WebSocket clients. This library is designed to be used by other library +writers, to write applications that use WebSockets, and is not useful by +itself.") + (license license:gpl3+))) + +(define-public emacs-oauth2 + (package + (name "emacs-oauth2") + (version "0.11") + (source + (origin + (method url-fetch) + (uri (string-append "https://elpa.gnu.org/packages/oauth2-" + version ".el")) + (sha256 + (base32 + "0ydkc9jazsnbbvfhd47mql52y7k06n3z7r0naqxkwb99j9blqsmp")))) + (build-system emacs-build-system) + (home-page "http://elpa.gnu.org/packages/oauth2.html") + (synopsis "OAuth 2.0 authorization protocol implementation") + (description + "This package provides an Elisp implementation of the OAuth 2.0 draft. +The main entry point is @code{oauth2-auth-and-store} which will return a token +structure. This token structure can be then used with +@code{oauth2-url-retrieve-synchronously} or @code{oauth2-url-retrieve} to +retrieve any data that need OAuth authentication to be accessed. If the token +needs to be refreshed, the code handles it automatically and stores the new +value of the access token.") + (license license:gpl3+))) + +(define-public emacs-circe + (package + (name "emacs-circe") + (version "2.10") + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/jorgenschaefer/circe.git") + (commit (string-append "v" version)))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "10gi14kwxd81blddpvqh95lgmpbfgp0m955naxix3bs3r6a75n4s")))) + (build-system emacs-build-system) + (arguments + `(#:tests? #t + #:test-command '("buttercup" "-L" ".") + #:phases + (modify-phases %standard-phases + ;; The HOME environment variable should be set to an existing + ;; directory for the tests to succeed. + (add-before 'check 'set-home + (lambda _ + (setenv "HOME" "/tmp") + #t))))) + (native-inputs + `(("emacs-buttercup" ,emacs-buttercup))) + ;; In order to securely connect to an IRC server using TLS, Circe requires + ;; the GnuTLS binary. + (propagated-inputs + `(("gnutls" ,gnutls))) + (home-page "https://github.com/jorgenschaefer/circe") + (synopsis "Client for IRC in Emacs") + (description "Circe is a Client for IRC in Emacs. It integrates well with +the rest of the editor, using standard Emacs key bindings and indicating +activity in channels in the status bar so it stays out of your way unless you +want to use it.") + (license license:gpl3+))) + +(define-public emacs-tracking + (package + (inherit emacs-circe) + (name "emacs-tracking") + (arguments + ;; "tracking.el" is a library extracted from Circe package. It requires + ;; "shorten.el". + `(#:include '("^shorten.el$" "^tracking.el$") + ,@(package-arguments emacs-circe))) + (home-page "https://github.com/jorgenschaefer/circe/wiki/Tracking") + (synopsis "Buffer tracking library") + (description "@code{tracking.el} provides a way for different modes to +notify the user that a buffer needs attention. The user then can cycle +through them using @key{C-c C-SPC}.") + (license license:gpl3+))) + +(define-public emacs-slack + (let ((commit "99a57501629a0329a9ca090c1ea1296462eda02d") + (revision "5")) + (package + (name "emacs-slack") + (version (git-version "0.0.2" revision commit)) + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/yuya373/emacs-slack.git") + (commit commit))) + (file-name (git-file-name name commit)) + (sha256 + (base32 + "0jw1diypfw8pmzkq0napgxmfc0gqka7zcccgnw359604lr30k2z2")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-alert" ,emacs-alert) + ("emacs-emojify" ,emacs-emojify) + ("emacs-helm" ,emacs-helm) + ("emacs-request" ,emacs-request) + ("emacs-websocket" ,emacs-websocket) + ("emacs-oauth2" ,emacs-oauth2) + ("emacs-circe" ,emacs-circe))) + (home-page "https://github.com/yuya373/emacs-slack") + (synopsis "Slack client for Emacs") + (description "This package provides an Emacs client for the Slack +messaging service.") + (license license:gpl3+)))) + +(define-public emacs-bash-completion + (package + (name "emacs-bash-completion") + (version "2.1.0") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/szermatt/emacs-bash-completion/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1z0qck3v3ra6ivacn8n04w1v33a4xn01xx860761q31qzsv3sksq")))) + (inputs `(("bash" ,bash))) + (build-system emacs-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-before 'install 'configure + (lambda* (#:key inputs #:allow-other-keys) + (let ((bash (assoc-ref inputs "bash"))) + (emacs-substitute-variables "bash-completion.el" + ("bash-completion-prog" (string-append bash "/bin/bash")))) + #t))))) + (home-page "https://github.com/szermatt/emacs-bash-completion") + (synopsis "Bash completion for the shell buffer") + (description + "@code{bash-completion} defines dynamic completion hooks for shell-mode +and shell-command prompts that are based on Bash completion.") + (license license:gpl2+))) + +(define-public emacs-easy-kill + (package + (name "emacs-easy-kill") + (version "0.9.3") + (source (origin + (method url-fetch) + (uri (string-append "https://elpa.gnu.org/packages/easy-kill-" + version ".tar")) + (sha256 + (base32 + "17nw0mglmg877axwg1d0gs03yc0p04lzmd3pl0nsnqbh3303fnqb")))) + (build-system emacs-build-system) + (home-page "https://github.com/leoliu/easy-kill") + (synopsis "Kill and mark things easily in Emacs") + (description + "This package provides commands @code{easy-kill} and @code{easy-mark} to +let users kill or mark things easily.") + (license license:gpl3+))) + +(define-public emacs-csv-mode + (package + (name "emacs-csv-mode") + (version "1.7") + (source + (origin + (method url-fetch) + (uri (string-append "http://elpa.gnu.org/packages/csv-mode-" + version ".el")) + (sha256 + (base32 + "0r4bip0w3h55i8h6sxh06czf294mrhavybz0zypzrjw91m1bi7z6")))) + (build-system emacs-build-system) + (home-page + "http://elpa.gnu.org/packages/csv-mode.html") + (synopsis + "Major mode for editing comma/char separated values") + (description + "This Emacs package implements CSV mode, a major mode for editing records +in a generalized CSV (character-separated values) format.") + (license license:gpl3+))) + +(define-public emacs-transmission + (package + (name "emacs-transmission") + (version "0.12.1") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/holomorph/transmission/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1rrlgn96gi1ljfwbwvlyyxbq75xzamlbdhq1bpyadxxmxcvlmk3n")))) + (build-system emacs-build-system) + (home-page "https://github.com/holomorph/transmission") + (synopsis "Emacs interface to a Transmission session") + (description "This package provides an Emacs interface to interact with a +running session of the Transmission Bittorrent client. + +Features: + +@itemize +@item List, add, start/stop, verify, remove torrents. +@item Set speed limits, ratio limits, bandwidth priorities, trackers. +@item Navigate to the corresponding file list, torrent info, peer info +contexts. +@item Toggle downloading and set priorities for individual files. +@end itemize\n") + (license license:gpl3+))) + +(define-public emacs-polymode + (package + (name "emacs-polymode") + (version "0.1.5") + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/vspinu/polymode.git") + (commit (string-append "v" version)))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "0wwphs54jx48a3ca6x1qaz56j3j9bg4mv8g2akkffrzbdcb8sbc7")))) + (build-system emacs-build-system) + (arguments + `(#:include (cons* "^modes/.*\\.el$" %default-include) + #:phases + (modify-phases %standard-phases + (add-after 'set-emacs-load-path 'add-modes-subdir-to-load-path + (lambda _ + (setenv "EMACSLOADPATH" + (string-append (getenv "EMACSLOADPATH") + ":" (getcwd) "/modes" ":"))))))) + (home-page "https://github.com/vspinu/polymode") + (synopsis "Framework for multiple Emacs modes based on indirect buffers") + (description "Polymode is an Emacs package that offers generic support +for multiple major modes inside a single Emacs buffer. It is lightweight, +object oriented and highly extensible. Creating a new polymode typically +takes only a few lines of code. Polymode also provides extensible facilities +for external literate programming tools for exporting, weaving and tangling.") + (license license:gpl3+))) + +(define-public emacs-polymode-ansible + (let ((commit "b26094d029e25dc797b94254f797e7807a57e4c8")) + (package + (name "emacs-polymode-ansible") + ;; No upstream version release yet. + (version (git-version "0.1" "1" commit)) + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://gitlab.com/mavit/poly-ansible") + (commit commit))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "055shddqibib3hx2ykwdz910nrqws40cd407mq946l2bf6v87gj6")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-ansible-doc" ,emacs-ansible-doc) + ("emacs-jinja2-mode" ,emacs-jinja2-mode) + ("emacs-polymode" ,emacs-polymode) + ("emacs-yaml-mode" ,emacs-yaml-mode))) + (properties '((upstream-name . "poly-ansible"))) + (home-page "https://gitlab.com/mavit/poly-ansible/") + (synopsis "Polymode for Ansible - Jinja2 in YAML") + (description + "Edit YAML files for Ansible containing embedded Jinja2 templating.") + (license license:gpl3+)))) + +(define-public eless + (package + (name "eless") + (version "0.3") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/kaushalmodi/eless/archive/" + "v" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0gjnnhgw5xs1w3qfnkvwa2nv44gnxr8pkhx3c7qig45p8nh1461h")))) + (build-system trivial-build-system) + (inputs + `(("bash" ,bash))) + (native-inputs + `(("tar" ,tar) + ("gzip" ,gzip))) + (arguments + `(#:modules ((guix build utils)) + #:builder + (begin + (use-modules (guix build utils)) + (setenv "PATH" (string-append + (assoc-ref %build-inputs "tar") "/bin" ":" + (assoc-ref %build-inputs "gzip") "/bin")) + (invoke "tar" "xvf" (assoc-ref %build-inputs "source")) + (chdir (string-append "eless" "-" ,version)) + (substitute* "eless" (("/usr/bin/env bash") + (string-append (assoc-ref %build-inputs "bash") + "/bin/bash"))) + (install-file "eless" (string-append %output "/bin")) + (install-file "doc/eless.info" (string-append %output "/share/info")) + #t))) + (home-page "https://github.com/kaushalmodi/eless") + (synopsis "Use Emacs as a paginator") + (description "@code{eless} provides a combination of Bash script +and a minimal Emacs view-mode. + +Feautures: + +@itemize +@item Independent of a user’s Emacs config. +@item Customizable via the @code{(locate-user-emacs-file \"elesscfg\")} config. +@item Not require an Emacs server to be already running. +@item Syntax highlighting. +@item Org-mode file rendering. +@item @code{man} page viewer. +@item Info viewer. +@item Dired, wdired, (batch edit symbolic links). +@item Colored diffs, git diff, git log, ls with auto ANSI detection. +@item Filter log files lines matching a regexp. +@item Auto-revert log files similar to @code{tail -f}. +@item Quickly change frame and font sizes. +@end itemize\n") + (license license:expat))) + +(define-public emacs-evil-matchit + (package + (name "emacs-evil-matchit") + (version "2.2.6") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/redguardtoo/evil-matchit/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1yp9sl6542317mn1060ri90zyf6bs6qylagndhqy02p368q31rhi")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-evil" ,emacs-evil))) + (home-page "https://github.com/redguardtoo/evil-matchit") + (synopsis "Vim matchit ported into Emacs") + (description + "@code{evil-matchit} is a minor mode for jumping between matching tags in +evil mode using @kbd{%}. It is a port of @code{matchit} for Vim.") + (license license:gpl3+))) + +(define-public emacs-evil-smartparens + (package + (name "emacs-evil-smartparens") + (version "0.4.0") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/expez/evil-smartparens/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1bwzdd3054d407d5j4m3njsbvmc9r8zzp33m32pj3b3irxrl68q0")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-evil" ,emacs-evil) + ("emacs-smartparens" ,emacs-smartparens))) + (home-page "https://github.com/expez/evil-smartparens") + (synopsis "Emacs Evil integration for Smartparens") + (description "@code{emacs-evil-smartparens} is an Emacs minor mode which +makes Evil play nice with Smartparens. Evil is an Emacs minor mode that +emulates Vim features and provides Vim-like key bindings.") + (license license:gpl3+))) + +(define-public emacs-evil-quickscope + (package + (name "emacs-evil-quickscope") + (version "0.1.4") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/blorbx/evil-quickscope/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1r26a412mmar7vbf89zcifswiwpdg30mjzj32xdyqss57aqi83ma")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-evil" ,emacs-evil))) + (arguments + `(#:tests? #t + #:test-command '("emacs" "--batch" + "-l" "evil-quickscope-tests.el" + "-f" "ert-run-tests-batch-and-exit"))) + (home-page "https://github.com/blorbx/evil-quickscope") + (synopsis "Target highlighting for emacs evil-mode f,F,t and T commands") + (description "@code{emacs-evil-quickscope} highlights targets for Evil +mode’s f,F,t,T keys, allowing for quick navigation within a line. It is a +port of quick-scope for Vim. Evil is an Emacs minor mode that emulates Vim +features and provides Vim-like key bindings.") + (license license:gpl3+))) + +(define-public emacs-bongo + (package + (name "emacs-bongo") + (version "1.0") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/dbrock/bongo/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1pcsyyrvj7djjjwpaswd1i782hvqvlvs39cy9ns0k795si6xd64d")))) + (build-system emacs-build-system) + (home-page "https://github.com/dbrock/bongo") + (synopsis "Media player for Emacs") + (description + "This package provides a flexible media player for Emacs. @code{Bongo} +supports multiple backends such as @code{vlc}, @code{mpg123}, +@code{ogg123}, @code{speexdec}, @code{timidity}, @code{mikmod} and +@code{afplay}.") + (license license:gpl2+))) + +(define-public emacs-groovy-modes + (package + (name "emacs-groovy-modes") + (version "2.0") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/Groovy-Emacs-Modes/groovy-emacs-modes" + "/archive/" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "15j0hnkx9nppjzda5cqsxxz5f3bq9hc4xfyjcdypzqiypcvmpa39")))) + (build-system emacs-build-system) + (propagated-inputs + `(("emacs-s" ,emacs-s))) + (home-page "https://github.com/Groovy-Emacs-Modes/groovy-emacs-modes") + (synopsis "Groovy related modes for Emacs") + (description + "This package provides @code{groovy-mode} for syntax highlighing in +Groovy source files, REPL integration with run-groovy and Grails project +navigation with the grails mode.") + (license license:gpl3+))) + +(define-public groovy-emacs-modes + (deprecated-package "groovy-emacs-modes" emacs-groovy-modes)) + +(define-public emacs-org-tree-slide + (let ((commit "dff8f1a4a64c8dd0a1fde0b0131e2fe186747134") + (revision "0")) + (package + (name "emacs-org-tree-slide") + (version (git-version "0.1" revision commit)) + (home-page "https://github.com/takaxp/org-tree-slide") + (source (origin + (method git-fetch) + (uri (git-reference (url home-page) (commit commit))) + (sha256 + (base32 + "153bg0x7ypla11pq51jmsgzfjklwwnrq56xgpbfhk1j16xwz9hyf")) + (file-name (git-file-name name version)))) + (build-system emacs-build-system) + (synopsis "Presentation tool for org-mode") + (description + "Org-tree-slide provides a slideshow mode to view org-mode files. Use +@code{org-tree-slide-mode} to enter the slideshow mode, and then @kbd{C->} and +@kbd{C-<} to jump to the next and previous slide.") + (license license:gpl3+)))) + +(define-public emacs-scratch-el + (let ((commit "2cdf2b841ce7a0987093f65b0cc431947549f897") + (revision "1")) + (package + (name "emacs-scratch-el") + (version (git-version "1.2" revision commit)) + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/ieure/scratch-el.git") + (commit commit))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "0wscsndynjmnliajqaz28r1ww81j8wh84zwaaswx51abhwgl0idf")))) + (build-system emacs-build-system) + (native-inputs + `(("texinfo" ,texinfo))) + (arguments + '(#:phases + (modify-phases %standard-phases + (add-after 'install 'install-doc + (lambda* (#:key outputs #:allow-other-keys) + (unless (invoke "makeinfo" "scratch.texi") + (error "makeinfo failed")) + (install-file "scratch.info" + (string-append (assoc-ref outputs "out") + "/share/info")) + #t))))) + (home-page "https://github.com/ieure/scratch-el/") + (synopsis "Create scratch buffers with the same mode as current buffer") + (description "Scratch is an extension to Emacs that enables one to create +scratch buffers that are in the same mode as the current buffer. This is +notably useful when working on code in some language; you may grab code into a +scratch buffer, and, by virtue of this extension, do so using the Emacs +formatting rules for that language.") + (license license:bsd-2)))) + +(define-public emacs-kv + (package + (name "emacs-kv") + (version "0.0.19") + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/nicferrier/emacs-kv.git") + (commit "721148475bce38a70e0b678ba8aa923652e8900e"))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "0r0lz2s6gvy04fwnafai668jsf4546h4k6zd6isx5wpk0n33pj5m")))) + (build-system emacs-build-system) + (arguments + `(#:tests? #t + #:test-command '("emacs" "--batch" "-l" "kv-tests.el" + "-f" "ert-run-tests-batch-and-exit"))) + (home-page "https://github.com/nicferrier/emacs-kv") + (synopsis "Key/Value data structures library for Emacs Lisp") + (description "@code{emacs-kv} is a collection of tools for dealing with +key/value data structures such as plists, alists and hash-tables in Emacs +Lisp.") + (license license:gpl3+))) + +(define-public emacs-esxml + (package + (name "emacs-esxml") + (version "0.3.4") + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/tali713/esxml.git") + (commit version))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "00vv8a75wdklygdyr4km9mc2ismxak69c45jmcny41xl44rp9x8m")))) + (build-system emacs-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-after 'unpack 'fix-sources + (lambda _ + ;; See: https://github.com/tali713/esxml/pull/28. + (substitute* "css-lite.el" + ((";;; main interface") + (string-append ";;; main interface\n" + "(require 'cl-lib)")) + (("mapcan") + "cl-mapcan") + (("',\\(cl-mapcan #'process-css-rule rules\\)") + "(cl-mapcan #'process-css-rule ',rules)")) + (substitute* "esxml-form.el" + ((",esxml-form-field-defn") + "#'esxml-form-field-defn")) + ;; See: https://github.com/tali713/esxml/issues/25 + (delete-file "esxpath.el") + #t))))) + (propagated-inputs + `(("emacs-kv" ,emacs-kv))) + (home-page "https://github.com/tali713/esxml/") + (synopsis "SXML for EmacsLisp") + (description "This is XML/XHTML done with S-Expressions in EmacsLisp. +Simply, this is the easiest way to write HTML or XML in Lisp. This library +uses the native form of XML representation as used by many libraries already +included within Emacs. See @code{esxml-to-xml} for a concise description of +the format.") + (license license:gpl3+))) + +(define-public emacs-nov-el + (package + (name "emacs-nov-el") + (version "0.2.6") + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/wasamasa/nov.el.git") + (commit version))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "188h5gzn1zf443g0b7q5bpmvvpr6ds5h8aci8vxc92py56rhyrvc")))) + (build-system emacs-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-after 'unpack 'embed-path-to-unzip + (lambda _ + (substitute* "nov.el" + (("\\(executable-find \"unzip\"\\)") + (string-append "\"" (which "unzip") "\""))) + #t))))) + (propagated-inputs + `(("emacs-dash" ,emacs-dash) + ("emacs-esxml" ,emacs-esxml))) + (inputs + `(("unzip" ,unzip))) + (home-page "https://github.com/wasamasa/nov.el/") + (synopsis "Major mode for reading EPUBs in Emacs") + (description "@code{nov.el} provides a major mode for reading EPUB +documents. + +Features: + +@itemize +@item Basic navigation (jump to TOC, previous/next chapter) +@item Remembering and restoring the last read position +@item Jump to next chapter when scrolling beyond end +@item Renders EPUB2 (@code{.ncx}) and EPUB3 (@code{