Merge branch 'master' into core-updates

This commit is contained in:
Mark H Weaver 2014-08-20 03:17:56 -04:00
commit 647cfda83b
64 changed files with 3815 additions and 625 deletions

View File

@ -29,6 +29,10 @@
(eval . (put 'call-with-compressed-output-port 'scheme-indent-function 2)) (eval . (put 'call-with-compressed-output-port 'scheme-indent-function 2))
(eval . (put 'call-with-decompressed-port 'scheme-indent-function 2)) (eval . (put 'call-with-decompressed-port 'scheme-indent-function 2))
(eval . (put 'signature-case 'scheme-indent-function 1)) (eval . (put 'signature-case 'scheme-indent-function 1))
(eval . (put 'emacs-batch-eval 'scheme-indent-function 0))
(eval . (put 'emacs-batch-edit-file 'scheme-indent-function 1))
(eval . (put 'emacs-substitute-sexps 'scheme-indent-function 1))
(eval . (put 'emacs-substitute-variables 'scheme-indent-function 1))
(eval . (put 'syntax-parameterize 'scheme-indent-function 1)) (eval . (put 'syntax-parameterize 'scheme-indent-function 1))
(eval . (put 'with-monad 'scheme-indent-function 1)) (eval . (put 'with-monad 'scheme-indent-function 1))
@ -36,11 +40,12 @@
(eval . (put 'mlet 'scheme-indent-function 2)) (eval . (put 'mlet 'scheme-indent-function 2))
(eval . (put 'run-with-store 'scheme-indent-function 1)) (eval . (put 'run-with-store 'scheme-indent-function 1))
;; Recognize '~' and '$', as used for gexps, as quotation symbols. This ;; Recognize '~', '+', and '$', as used for gexps, as quotation symbols.
;; notably allows '(' in Paredit to not insert a space when the preceding ;; This notably allows '(' in Paredit to not insert a space when the
;; symbol is one of these. ;; preceding symbol is one of these.
(eval . (modify-syntax-entry ?~ "'")) (eval . (modify-syntax-entry ?~ "'"))
(eval . (modify-syntax-entry ?$ "'")))) (eval . (modify-syntax-entry ?$ "'"))
(eval . (modify-syntax-entry ?+ "'"))))
(emacs-lisp-mode . ((indent-tabs-mode . nil))) (emacs-lisp-mode . ((indent-tabs-mode . nil)))
(texinfo-mode . ((indent-tabs-mode . nil) (texinfo-mode . ((indent-tabs-mode . nil)
(fill-column . 72)))) (fill-column . 72))))

View File

@ -9,6 +9,7 @@ The fine people listed below have contributed code to GNU Guix (in
alphabetical order): alphabetical order):
Eric Bavier <bavier@member.fsf.org> Eric Bavier <bavier@member.fsf.org>
Taylan Ulrich Bayirli/Kammer <taylanbayirli@gmail.com>
Ludovic Courtès <ludo@gnu.org> Ludovic Courtès <ludo@gnu.org>
John Darrington <jmd@gnu.org> John Darrington <jmd@gnu.org>
Andreas Enge <andreas@enge.fr> Andreas Enge <andreas@enge.fr>

View File

@ -37,6 +37,7 @@ MODULES = \
guix/download.scm \ guix/download.scm \
guix/git-download.scm \ guix/git-download.scm \
guix/monads.scm \ guix/monads.scm \
guix/monad-repl.scm \
guix/gexp.scm \ guix/gexp.scm \
guix/profiles.scm \ guix/profiles.scm \
guix/serialization.scm \ guix/serialization.scm \
@ -73,6 +74,7 @@ MODULES = \
guix/build/install.scm \ guix/build/install.scm \
guix/build/activation.scm \ guix/build/activation.scm \
guix/build/syscalls.scm \ guix/build/syscalls.scm \
guix/build/emacs-utils.scm \
guix/packages.scm \ guix/packages.scm \
guix/snix.scm \ guix/snix.scm \
guix/scripts/download.scm \ guix/scripts/download.scm \
@ -107,9 +109,13 @@ KCONFIGS = \
gnu/packages/linux-libre-i686.conf \ gnu/packages/linux-libre-i686.conf \
gnu/packages/linux-libre-x86_64.conf gnu/packages/linux-libre-x86_64.conf
# Templates, examples.
EXAMPLES = \
gnu/system/os-config.tmpl
GOBJECTS = $(MODULES:%.scm=%.go) guix/config.go GOBJECTS = $(MODULES:%.scm=%.go) guix/config.go
nobase_dist_guilemodule_DATA = $(MODULES) $(KCONFIGS) nobase_dist_guilemodule_DATA = $(MODULES) $(KCONFIGS) $(EXAMPLES)
nobase_nodist_guilemodule_DATA = $(GOBJECTS) guix/config.scm nobase_nodist_guilemodule_DATA = $(GOBJECTS) guix/config.scm
# Do we need to provide our own non-broken (srfi srfi-37) module? # Do we need to provide our own non-broken (srfi srfi-37) module?

2
THANKS
View File

@ -7,7 +7,6 @@ suggestions, bug reports, patches, internationalization, or general
infrastructure help: infrastructure help:
Lluís Batlle i Rossell <viric@viric.name> Lluís Batlle i Rossell <viric@viric.name>
Taylan Ulrich Bayirli/Kammer <taylanbayirli@gmail.com>
Marek Benc <merkur32@gmail.com> Marek Benc <merkur32@gmail.com>
Carlos Carleos <carleos@uniovi.es> Carlos Carleos <carleos@uniovi.es>
Felipe Castro <fefcas@gmail.com> Felipe Castro <fefcas@gmail.com>
@ -26,6 +25,5 @@ infrastructure help:
Adam Pribyl <pribyl@lowlevel.cz> Adam Pribyl <pribyl@lowlevel.cz>
Cyrill Schenkel <cyrill.schenkel@gmail.com> Cyrill Schenkel <cyrill.schenkel@gmail.com>
Benno Schulenberg <coordinator@translationproject.org> Benno Schulenberg <coordinator@translationproject.org>
Jason Self <jself@gnu.org>
Alen Skondro <askondro@gmail.com> Alen Skondro <askondro@gmail.com>
Matthias Wachs <wachs@net.in.tum.de> Matthias Wachs <wachs@net.in.tum.de>

View File

@ -548,7 +548,7 @@ on the kernel version number.
@item --lose-logs @item --lose-logs
Do not keep build logs. By default they are kept under Do not keep build logs. By default they are kept under
@code{@var{localstatedir}/nix/log}. @code{@var{localstatedir}/guix/log}.
@item --system=@var{system} @item --system=@var{system}
Assume @var{system} as the current system type. By default it is the Assume @var{system} as the current system type. By default it is the
@ -1937,6 +1937,33 @@ effect, one must use @code{run-with-store}:
@result{} /gnu/store/...-profile.sh @result{} /gnu/store/...-profile.sh
@end example @end example
Note that the @code{(guix monad-repl)} module extends Guile's REPL with
new ``meta-commands'' to make it easier to deal with monadic procedures:
@code{run-in-store}, and @code{enter-store-monad}. The former, is used
to ``run'' a single monadic value through the store:
@example
scheme@@(guile-user)> ,run-in-store (package->derivation hello)
$1 = #<derivation /gnu/store/@dots{}-hello-2.9.drv => @dots{}>
@end example
The latter enters a recursive REPL, where all the return values are
automatically run through the store:
@example
scheme@@(guile-user)> ,enter-store-monad
store-monad@@(guile-user) [1]> (package->derivation hello)
$2 = #<derivation /gnu/store/@dots{}-hello-2.9.drv => @dots{}>
store-monad@@(guile-user) [1]> (text-file "foo" "Hello!")
$3 = "/gnu/store/@dots{}-foo"
store-monad@@(guile-user) [1]> ,q
scheme@@(guile-user)>
@end example
@noindent
Note that non-monadic values cannot be returned in the
@code{store-monad} REPL.
The main syntactic forms to deal with monads in general are described The main syntactic forms to deal with monads in general are described
below. below.
@ -2038,15 +2065,19 @@ The example below adds a file to the store, under two different names:
@end deffn @end deffn
@deffn {Monadic Procedure} package-file @var{package} [@var{file}] @ @deffn {Monadic Procedure} package-file @var{package} [@var{file}] @
[#:system (%current-system)] [#:output "out"] Return as a monadic [#:system (%current-system)] [#:target #f] @
[#:output "out"] Return as a monadic
value in the absolute file name of @var{file} within the @var{output} value in the absolute file name of @var{file} within the @var{output}
directory of @var{package}. When @var{file} is omitted, return the name directory of @var{package}. When @var{file} is omitted, return the name
of the @var{output} directory of @var{package}. of the @var{output} directory of @var{package}. When @var{target} is
true, use it as a cross-compilation target triplet.
@end deffn @end deffn
@deffn {Monadic Procedure} package->derivation @var{package} [@var{system}] @deffn {Monadic Procedure} package->derivation @var{package} [@var{system}]
Monadic version of @code{package-derivation} (@pxref{Defining @deffnx {Monadic Procedure} package->cross-derivation @var{package} @
Packages}). @var{target} [@var{system}]
Monadic version of @code{package-derivation} and
@code{package-cross-derivation} (@pxref{Defining Packages}).
@end deffn @end deffn
@ -2129,8 +2160,32 @@ substituted to the reference to the @var{coreutils} package in the
actual build code, and @var{coreutils} is automatically made an input to actual build code, and @var{coreutils} is automatically made an input to
the derivation. Likewise, @code{#$output} (equivalent to @code{(ungexp the derivation. Likewise, @code{#$output} (equivalent to @code{(ungexp
output)}) is replaced by a string containing the derivation's output output)}) is replaced by a string containing the derivation's output
directory name. The syntactic form to construct gexps is summarized directory name.
below.
@cindex cross compilation
In a cross-compilation context, it is useful to distinguish between
references to the @emph{native} build of a package---that can run on the
host---versus references to cross builds of a package. To that end, the
@code{#+} plays the same role as @code{#$}, but is a reference to a
native package build:
@example
(gexp->derivation "vi"
#~(begin
(mkdir #$output)
(system* (string-append #+coreutils "/bin/ln")
"-s"
(string-append #$emacs "/bin/emacs")
(string-append #$output "/bin/vi")))
#:target "mips64el-linux")
@end example
@noindent
In the example above, the native build of @var{coreutils} is used, so
that @command{ln} can actually run on the host; but then the
cross-compiled build of @var{emacs} is referenced.
The syntactic form to construct gexps is summarized below.
@deffn {Scheme Syntax} #~@var{exp} @deffn {Scheme Syntax} #~@var{exp}
@deffnx {Scheme Syntax} (gexp @var{exp}) @deffnx {Scheme Syntax} (gexp @var{exp})
@ -2159,6 +2214,13 @@ This is like the form above, but referring explicitly to the
@var{package-or-derivation} produces multiple outputs (@pxref{Packages @var{package-or-derivation} produces multiple outputs (@pxref{Packages
with Multiple Outputs}). with Multiple Outputs}).
@item #+@var{obj}
@itemx #+@var{obj}:output
@itemx (ungexp-native @var{obj})
@itemx (ungexp-native @var{obj} @var{output})
Same as @code{ungexp}, but produces a reference to the @emph{native}
build of @var{obj} when used in a cross compilation context.
@item #$output[:@var{output}] @item #$output[:@var{output}]
@itemx (ungexp output [@var{output}]) @itemx (ungexp output [@var{output}])
Insert a reference to derivation output @var{output}, or to the main Insert a reference to derivation output @var{output}, or to the main
@ -2171,6 +2233,11 @@ This only makes sense for gexps passed to @code{gexp->derivation}.
Like the above, but splices the contents of @var{lst} inside the Like the above, but splices the contents of @var{lst} inside the
containing list. containing list.
@item #+@@@var{lst}
@itemx (ungexp-native-splicing @var{lst})
Like the above, but refers to native builds of the objects listed in
@var{lst}.
@end table @end table
G-expressions created by @code{gexp} or @code{#~} are run-time objects G-expressions created by @code{gexp} or @code{#~} are run-time objects
@ -2187,13 +2254,15 @@ below allow you to do that (@pxref{The Store Monad}, for more
information about monads.) information about monads.)
@deffn {Monadic Procedure} gexp->derivation @var{name} @var{exp} @ @deffn {Monadic Procedure} gexp->derivation @var{name} @var{exp} @
[#:system (%current-system)] [#:inputs '()] @ [#:system (%current-system)] [#:target #f] [#:inputs '()] @
[#:hash #f] [#:hash-algo #f] @ [#:hash #f] [#:hash-algo #f] @
[#:recursive? #f] [#:env-vars '()] [#:modules '()] @ [#:recursive? #f] [#:env-vars '()] [#:modules '()] @
[#:references-graphs #f] [#:local-build? #f] @ [#:references-graphs #f] [#:local-build? #f] @
[#:guile-for-build #f] [#:guile-for-build #f]
Return a derivation @var{name} that runs @var{exp} (a gexp) with Return a derivation @var{name} that runs @var{exp} (a gexp) with
@var{guile-for-build} (a derivation) on @var{system}. @var{guile-for-build} (a derivation) on @var{system}. When @var{target}
is true, it is used as the cross-compilation target triplet for packages
referred to by @var{exp}.
Make @var{modules} available in the evaluation context of @var{EXP}; Make @var{modules} available in the evaluation context of @var{EXP};
@var{MODULES} is a list of names of Guile modules from the current @var{MODULES} is a list of names of Guile modules from the current

View File

@ -37,6 +37,7 @@ GNU_SYSTEM_MODULES = \
gnu/packages/autogen.scm \ gnu/packages/autogen.scm \
gnu/packages/autotools.scm \ gnu/packages/autotools.scm \
gnu/packages/avahi.scm \ gnu/packages/avahi.scm \
gnu/packages/avrdude.scm \
gnu/packages/backup.scm \ gnu/packages/backup.scm \
gnu/packages/base.scm \ gnu/packages/base.scm \
gnu/packages/bash.scm \ gnu/packages/bash.scm \
@ -154,7 +155,6 @@ GNU_SYSTEM_MODULES = \
gnu/packages/lsh.scm \ gnu/packages/lsh.scm \
gnu/packages/lsof.scm \ gnu/packages/lsof.scm \
gnu/packages/lua.scm \ gnu/packages/lua.scm \
gnu/packages/lvm.scm \
gnu/packages/lynx.scm \ gnu/packages/lynx.scm \
gnu/packages/m4.scm \ gnu/packages/m4.scm \
gnu/packages/man.scm \ gnu/packages/man.scm \
@ -184,6 +184,7 @@ GNU_SYSTEM_MODULES = \
gnu/packages/onc-rpc.scm \ gnu/packages/onc-rpc.scm \
gnu/packages/openldap.scm \ gnu/packages/openldap.scm \
gnu/packages/openssl.scm \ gnu/packages/openssl.scm \
gnu/packages/orpheus.scm \
gnu/packages/package-management.scm \ gnu/packages/package-management.scm \
gnu/packages/parallel.scm \ gnu/packages/parallel.scm \
gnu/packages/patchutils.scm \ gnu/packages/patchutils.scm \
@ -207,6 +208,7 @@ GNU_SYSTEM_MODULES = \
gnu/packages/rdf.scm \ gnu/packages/rdf.scm \
gnu/packages/readline.scm \ gnu/packages/readline.scm \
gnu/packages/recutils.scm \ gnu/packages/recutils.scm \
gnu/packages/rrdtool.scm \
gnu/packages/rsync.scm \ gnu/packages/rsync.scm \
gnu/packages/rush.scm \ gnu/packages/rush.scm \
gnu/packages/samba.scm \ gnu/packages/samba.scm \
@ -268,7 +270,6 @@ GNU_SYSTEM_MODULES = \
gnu/system/file-systems.scm \ gnu/system/file-systems.scm \
gnu/system/grub.scm \ gnu/system/grub.scm \
gnu/system/install.scm \ gnu/system/install.scm \
gnu/system/os-config.tmpl \
gnu/system/linux.scm \ gnu/system/linux.scm \
gnu/system/linux-initrd.scm \ gnu/system/linux-initrd.scm \
gnu/system/shadow.scm \ gnu/system/shadow.scm \
@ -280,6 +281,7 @@ dist_patch_DATA = \
gnu/packages/patches/apr-skip-getservbyname-test.patch \ gnu/packages/patches/apr-skip-getservbyname-test.patch \
gnu/packages/patches/automake-skip-amhello-tests.patch \ gnu/packages/patches/automake-skip-amhello-tests.patch \
gnu/packages/patches/avahi-localstatedir.patch \ gnu/packages/patches/avahi-localstatedir.patch \
gnu/packages/patches/avrdude-fix-libusb.patch \
gnu/packages/patches/bigloo-gc-shebangs.patch \ gnu/packages/patches/bigloo-gc-shebangs.patch \
gnu/packages/patches/binutils-ld-new-dtags.patch \ gnu/packages/patches/binutils-ld-new-dtags.patch \
gnu/packages/patches/binutils-loongson-workaround.patch \ gnu/packages/patches/binutils-loongson-workaround.patch \
@ -291,7 +293,6 @@ dist_patch_DATA = \
gnu/packages/patches/cpio-gets-undeclared.patch \ gnu/packages/patches/cpio-gets-undeclared.patch \
gnu/packages/patches/cssc-gets-undeclared.patch \ gnu/packages/patches/cssc-gets-undeclared.patch \
gnu/packages/patches/cssc-missing-include.patch \ gnu/packages/patches/cssc-missing-include.patch \
gnu/packages/patches/curl-fix-test172.patch \
gnu/packages/patches/cursynth-wave-rand.patch \ gnu/packages/patches/cursynth-wave-rand.patch \
gnu/packages/patches/dbus-localstatedir.patch \ gnu/packages/patches/dbus-localstatedir.patch \
gnu/packages/patches/diffutils-gets-undeclared.patch \ gnu/packages/patches/diffutils-gets-undeclared.patch \
@ -299,6 +300,7 @@ dist_patch_DATA = \
gnu/packages/patches/doxygen-tmake.patch \ gnu/packages/patches/doxygen-tmake.patch \
gnu/packages/patches/emacs-configure-sh.patch \ gnu/packages/patches/emacs-configure-sh.patch \
gnu/packages/patches/findutils-absolute-paths.patch \ gnu/packages/patches/findutils-absolute-paths.patch \
gnu/packages/patches/flashrom-use-libftdi1.patch \
gnu/packages/patches/flex-bison-tests.patch \ gnu/packages/patches/flex-bison-tests.patch \
gnu/packages/patches/gawk-shell.patch \ gnu/packages/patches/gawk-shell.patch \
gnu/packages/patches/gcc-cross-environment-variables.patch \ gnu/packages/patches/gcc-cross-environment-variables.patch \
@ -334,6 +336,7 @@ dist_patch_DATA = \
gnu/packages/patches/libtool-skip-tests.patch \ gnu/packages/patches/libtool-skip-tests.patch \
gnu/packages/patches/libtool-skip-tests-for-mips.patch \ gnu/packages/patches/libtool-skip-tests-for-mips.patch \
gnu/packages/patches/libssh-CVE-2014-0017.patch \ gnu/packages/patches/libssh-CVE-2014-0017.patch \
gnu/packages/patches/lm-sensors-hwmon-attrs.patch \
gnu/packages/patches/luit-posix.patch \ gnu/packages/patches/luit-posix.patch \
gnu/packages/patches/m4-gets-undeclared.patch \ gnu/packages/patches/m4-gets-undeclared.patch \
gnu/packages/patches/m4-readlink-EINVAL.patch \ gnu/packages/patches/m4-readlink-EINVAL.patch \
@ -344,6 +347,7 @@ dist_patch_DATA = \
gnu/packages/patches/mit-krb5-init-fix.patch \ gnu/packages/patches/mit-krb5-init-fix.patch \
gnu/packages/patches/mpc123-initialize-ao.patch \ gnu/packages/patches/mpc123-initialize-ao.patch \
gnu/packages/patches/module-init-tools-moduledir.patch \ gnu/packages/patches/module-init-tools-moduledir.patch \
gnu/packages/patches/orpheus-cast-errors-and-includes.patch \
gnu/packages/patches/patchelf-page-size.patch \ gnu/packages/patches/patchelf-page-size.patch \
gnu/packages/patches/patchutils-xfail-gendiff-tests.patch \ gnu/packages/patches/patchutils-xfail-gendiff-tests.patch \
gnu/packages/patches/perl-no-sys-dirs.patch \ gnu/packages/patches/perl-no-sys-dirs.patch \
@ -371,6 +375,8 @@ dist_patch_DATA = \
gnu/packages/patches/superlu-dist-scotchmetis.patch \ gnu/packages/patches/superlu-dist-scotchmetis.patch \
gnu/packages/patches/tcsh-fix-autotest.patch \ gnu/packages/patches/tcsh-fix-autotest.patch \
gnu/packages/patches/teckit-cstdio.patch \ gnu/packages/patches/teckit-cstdio.patch \
gnu/packages/patches/texi2html-document-encoding.patch \
gnu/packages/patches/texi2html-i18n.patch \
gnu/packages/patches/udev-gir-libtool.patch \ gnu/packages/patches/udev-gir-libtool.patch \
gnu/packages/patches/util-linux-perl.patch \ gnu/packages/patches/util-linux-perl.patch \
gnu/packages/patches/valgrind-glibc.patch \ gnu/packages/patches/valgrind-glibc.patch \

View File

@ -46,8 +46,12 @@
#:use-module (gnu packages flex) #:use-module (gnu packages flex)
#:use-module (gnu packages glib) #:use-module (gnu packages glib)
#:use-module (gnu packages pkg-config) #:use-module (gnu packages pkg-config)
#:use-module (gnu packages popt)
#:use-module (gnu packages texinfo) #:use-module (gnu packages texinfo)
#:use-module (gnu packages groff) #:use-module (gnu packages groff)
#:use-module (gnu packages pciutils)
#:use-module (gnu packages libusb)
#:use-module (gnu packages libftdi)
#:use-module (gnu packages xorg)) #:use-module (gnu packages xorg))
(define-public dmd (define-public dmd
@ -803,3 +807,136 @@ reliability depending on the manufacturer. This will often include usage
status for the CPU sockets, expansion slots (e.g. AGP, PCI, ISA) and memory status for the CPU sockets, expansion slots (e.g. AGP, PCI, ISA) and memory
module slots, and the list of I/O ports (e.g. serial, parallel, USB).") module slots, and the list of I/O ports (e.g. serial, parallel, USB).")
(license gpl2+))) (license gpl2+)))
(define-public flashrom
(package
(name "flashrom")
(version "0.9.7")
(source (origin
(method url-fetch)
(uri (string-append
"http://download.flashrom.org/releases/flashrom-"
version ".tar.bz2"))
(sha256
(base32
"1s9pc4yls2s1gcg2ar4q75nym2z5v6lxq36bl6lq26br00nj2mas"))
(patches (list (search-patch "flashrom-use-libftdi1.patch")))))
(build-system gnu-build-system)
(inputs `(("dmidecode" ,dmidecode)
("pciutils" ,pciutils)
("libusb" ,libusb)
("libftdi" ,libftdi)))
(native-inputs `(("pkg-config" ,pkg-config)))
(arguments
'(#:make-flags (list "CC=gcc" (string-append "PREFIX=" %output))
#:tests? #f ; no 'check' target
#:phases
(alist-delete
'configure
(alist-cons-before
'build 'patch-exec-paths
(lambda* (#:key inputs #:allow-other-keys)
(substitute* "dmi.c"
(("\"dmidecode\"")
(format #f "~S"
(string-append (assoc-ref inputs "dmidecode")
"/sbin/dmidecode")))))
%standard-phases))))
(home-page "http://flashrom.org/")
(synopsis "Identify, read, write, erase, and verify ROM/flash chips")
(description
"flashrom is a utility for identifying, reading, writing,
verifying and erasing flash chips. It is designed to flash
BIOS/EFI/coreboot/firmware/optionROM images on mainboards,
network/graphics/storage controller cards, and various other
programmer devices.")
(license gpl2)))
(define-public acpica
(package
(name "acpica")
(version "20140724")
(source (origin
(method url-fetch)
(uri (string-append
"https://acpica.org/sites/acpica/files/acpica-unix2-"
version ".tar.gz"))
(sha256
(base32
"01vdgrh7dsxrrvg5yd8sxm63cw8210pnsi5qg9g15ac53gn243ac"))))
(build-system gnu-build-system)
(native-inputs `(("flex" ,flex)
("bison" ,bison)))
(arguments
'(#:make-flags (list (string-append "PREFIX=" %output)
"HOST=_LINUX"
"OPT_CFLAGS=-Wall -fno-strict-aliasing")
#:tests? #f ; no 'check' target.
#:phases (alist-delete 'configure %standard-phases)))
(home-page "http://acpica.org/")
(synopsis "ACPICA tools for the development and debug of ACPI tables")
(description
"The ACPI Component Architecture (ACPICA) project provides an
OS-independent reference implementation of the Advanced Configuration and
Power Interface Specification (ACPI). ACPICA code contains those portions of
ACPI meant to be directly integrated into the host OS as a kernel-resident
subsystem, and a small set of tools to assist in developing and debugging ACPI
tables. This package contains only the user-space tools needed for ACPI table
development, not the kernel implementation of ACPI.")
(license gpl2))) ; Dual GPLv2/ACPICA Licence
(define-public stress
(package
(name "stress")
(version "1.0.1")
(source (origin
(method url-fetch)
(uri (string-append "mirror://debian/pool/main/s/stress/stress_"
version ".orig.tar.gz"))
(sha256
(base32
"1v9vnzlihqfjsxa93hdbrq72pqqk00dkylmlg8jpxhm7s1w9qfl1"))))
(build-system gnu-build-system)
(home-page "http://packages.debian.org/wheezy/stress")
(synopsis "A tool to impose load on and stress test a computer system")
(description
"'stress' is a tool that imposes a configurable amount of CPU, memory, I/O,
or disk stress on a POSIX-compliant operating system and reports any errors it
detects.
'stress' is not a benchmark. It is a tool used by system administrators to
evaluate how well their systems will scale, by kernel programmers to evaluate
perceived performance characteristics, and by systems programmers to expose
the classes of bugs which only or more frequently manifest themselves when the
system is under heavy load.")
(license gpl2+)))
(define-public detox
(package
(name "detox")
(version "1.2.0")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/detox/detox-"
version ".tar.bz2"))
(sha256
(base32
"1y6vvjqsg54kl49cry73jbfhr04s7wjs779vrr9zrq6kww7dkymb"))))
(build-system gnu-build-system)
;; Both flex and popt are used in this case for their runtime libraries
;; (libfl and libpopt).
(inputs
`(("flex" ,flex)
("popt" ,popt)))
(arguments
`(#:configure-flags `(,(string-append "--with-popt="
(assoc-ref %build-inputs "popt")))
#:tests? #f)) ;no 'check' target
(home-page "http://detox.sourceforge.net")
(synopsis "Clean up filenames")
(description
"Detox is a program that renames files to make them easier to work with
under Unix and related operating systems. Spaces and various other unsafe
characters (such as \"$\") get replaced with \"_\". ISO 8859-1 (Latin-1)
characters can be replaced as well, as can UTF-8 characters.")
(license bsd-3)))

View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -23,25 +24,31 @@
#:use-module (guix build-system gnu) #:use-module (guix build-system gnu)
#:use-module (gnu packages gettext) #:use-module (gnu packages gettext)
#:use-module (gnu packages maths) #:use-module (gnu packages maths)
#:use-module (gnu packages sqlite)
#:use-module (gnu packages readline)) #:use-module (gnu packages readline))
(define-public apl (define-public apl
(package (package
(name "apl") (name "apl")
(version "1.3") (version "1.4")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnu/apl/apl-" version ".tar.gz")) (uri (string-append "mirror://gnu/apl/apl-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1pkwlm0nf5vb8sp9hf9wjmsrsyr4vdpd4kv5y3hzmsgf3wcf8y3i")))) "0fl9l4jb5wpnb54kqkphavi657z1cv15h9qj2rqy2shf33dk3nk9"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(home-page "http://www.gnu.org/software/apl/") (home-page "http://www.gnu.org/software/apl/")
(inputs (inputs
`(("gettext" ,gnu-gettext) `(("gettext" ,gnu-gettext)
("lapack" ,lapack) ("lapack" ,lapack)
("sqlite" ,sqlite)
("readline" ,readline))) ("readline" ,readline)))
(arguments
`(#:configure-flags (list (string-append
"--with-sqlite3="
(assoc-ref %build-inputs "sqlite")))))
(synopsis "APL interpreter") (synopsis "APL interpreter")
(description (description
"GNU APL is a free interpreter for the programming language APL. It is "GNU APL is a free interpreter for the programming language APL. It is

View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com> ;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -28,14 +29,14 @@
(define-public apr (define-public apr
(package (package
(name "apr") (name "apr")
(version "1.4.8") (version "1.5.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://apache/apr/apr-" (uri (string-append "mirror://apache/apr/apr-"
version ".tar.bz2")) version ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"0884csfk3f530yscak0jlr6w929s3ys0n7fpwdg3dii1sgwd5f31")) "1b4qw686bwjn19iyb0lg918q23xxd6s2gnyczhjq992d3m1vwjp9"))
(patches (patches
(list (search-patch "apr-skip-getservbyname-test.patch"))) (list (search-patch "apr-skip-getservbyname-test.patch")))
(patch-flags '("-p0")))) (patch-flags '("-p0"))))
@ -44,7 +45,8 @@
;; Sometimes we end up with two processes concurrently trying to make ;; Sometimes we end up with two processes concurrently trying to make
;; 'libmod_test.la': <http://hydra.gnu.org/build/60266/nixlog/2/raw>. ;; 'libmod_test.la': <http://hydra.gnu.org/build/60266/nixlog/2/raw>.
;; Thus, build sequentially. ;; Thus, build sequentially.
'(#:parallel-build? #f)) '(#:parallel-build? #f
#:parallel-tests? #f))
(inputs `(("perl" ,perl) (inputs `(("perl" ,perl)
("libtool" ,libtool))) ("libtool" ,libtool)))
(home-page "http://apr.apache.org/") (home-page "http://apr.apache.org/")
@ -62,14 +64,14 @@ around or take advantage of platform-specific deficiencies or features.")
(define-public apr-util (define-public apr-util
(package (package
(name "apr-util") (name "apr-util")
(version "1.5.2") (version "1.5.3")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://apache/apr/apr-util-" (uri (string-append "mirror://apache/apr/apr-util-"
version ".tar.bz2")) version ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"19qjxpckb9p4j9pbk8kcirg6k5vqnjrqhnk9xx2c5m9964p3vkls")))) "0s1rpqjy5xr03k9s4xrsm5wvhj5286vlkf6jvqayw99yy5sb3vbq"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs (inputs
`(("apr" ,apr))) `(("apr" ,apr)))

58
gnu/packages/avrdude.scm Normal file
View File

@ -0,0 +1,58 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Manolis Fragkiskos Ragkousis <manolis837@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages avrdude)
#:use-module (guix licenses)
#:use-module (guix download)
#:use-module (guix packages)
#:use-module (gnu packages)
#:use-module (guix build-system gnu)
#:use-module (gnu packages bison)
#:use-module (gnu packages flex)
#:use-module (gnu packages elf)
#:use-module (gnu packages libusb)
#:use-module (gnu packages libftdi))
(define-public avrdude
(package
(name "avrdude")
(version "6.1")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://savannah/avrdude/avrdude-"
version ".tar.gz"))
(sha256
(base32
"0frxg0q09nrm95z7ymzddx7ysl77ilfbdix1m81d9jjpiv5bm64y"))
(patches (list (search-patch "avrdude-fix-libusb.patch")))))
(build-system gnu-build-system)
(inputs
`(("libelf" ,libelf)
("libusb" ,libusb)
("libftdi" ,libftdi)))
(native-inputs
`(("bison" ,bison)
("flex" ,flex)))
(home-page "http://www.nongnu.org/avrdude/")
(synopsis "AVR downloader and uploader")
(description
"AVRDUDE is a utility to download/upload/manipulate the ROM and
EEPROM contents of AVR microcontrollers using the in-system programming
technique (ISP).")
(license gpl2+)))

View File

@ -36,7 +36,7 @@
(define-public transmission (define-public transmission
(package (package
(name "transmission") (name "transmission")
(version "2.83") (version "2.84")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
@ -44,7 +44,7 @@
version ".tar.xz")) version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"0cqlgl6jmjw1caybz6nzh3l8z0jak1dxba01isv72zvy2r8b1qdh")))) "1sxr1magqb5s26yvr5yhs1f7bmir8gl09niafg64lhgfnhv1kz59"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(outputs '("out" ; library and command-line interface (outputs '("out" ; library and command-line interface
"gui")) ; graphical user interface "gui")) ; graphical user interface

View File

@ -24,7 +24,6 @@
#:use-module (guix build-system gnu) #:use-module (guix build-system gnu)
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (gnu packages gnupg) #:use-module (gnu packages gnupg)
#:use-module (gnu packages lvm)
#:use-module (gnu packages popt) #:use-module (gnu packages popt)
#:use-module (gnu packages python) #:use-module (gnu packages python)
#:use-module (gnu packages linux)) #:use-module (gnu packages linux))

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -37,18 +37,14 @@
(define-public curl (define-public curl
(package (package
(name "curl") (name "curl")
(version "7.35.0") (version "7.37.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "http://curl.haxx.se/download/curl-" (uri (string-append "http://curl.haxx.se/download/curl-"
version ".tar.lzma")) version ".tar.lzma"))
(sha256 (sha256
(base32 (base32
"14w5cwh6b1426lxkq6kp6h4vxryr4n7wfrrwhny1r4123q7n8ab9")) "10yfh4hy8wbkj43la238hg6h8i9wyp1cvvk8kl0giac1020imn5d"))))
(patches
;; This patch fixes testcase 172 which uses a hardcoded cookie
;; expiration value which is expired as of Feb 1, 2014.
(list (search-patch "curl-fix-test172.patch")))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs `(("gnutls" ,gnutls) (inputs `(("gnutls" ,gnutls)
("gss" ,gss) ("gss" ,gss)

View File

@ -1,5 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Taylan Ulrich Bayirli/Kammer <taylanbayirli@gmail.com>
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -21,6 +23,7 @@
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix download) #:use-module (guix download)
#:use-module (guix build-system gnu) #:use-module (guix build-system gnu)
#:use-module (guix build-system trivial)
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (gnu packages gtk) #:use-module (gnu packages gtk)
#:use-module (gnu packages ncurses) #:use-module (gnu packages ncurses)
@ -33,10 +36,17 @@
#:use-module (gnu packages image) #:use-module (gnu packages image)
#:use-module (gnu packages giflib) #:use-module (gnu packages giflib)
#:use-module (gnu packages linux) #:use-module (gnu packages linux)
#:use-module (gnu packages version-control)
#:use-module (gnu packages imagemagick)
#:use-module (gnu packages w3m)
#:use-module (gnu packages wget)
#:use-module (gnu packages autotools)
#:use-module ((gnu packages compression) #:use-module ((gnu packages compression)
#:renamer (symbol-prefix-proc 'compression:)) #:renamer (symbol-prefix-proc 'compression:))
#:use-module (gnu packages xml) #:use-module (gnu packages xml)
#:use-module (gnu packages glib)) #:use-module (gnu packages glib)
#:use-module (guix utils)
#:use-module (srfi srfi-1))
(define-public emacs (define-public emacs
(package (package
@ -102,6 +112,17 @@ large Lisp programs. It has full Unicode support for nearly all human
languages.") languages.")
(license gpl3+))) (license gpl3+)))
(define-public emacs-no-x-toolkit
(package (inherit emacs)
(name "emacs-no-x-toolkit")
(synopsis "The extensible, customizable, self-documenting text
editor (without an X toolkit)" )
(inputs (alist-delete "gtk+" (package-inputs emacs)))
(arguments
(substitute-keyword-arguments (package-arguments emacs)
((#:configure-flags flags)
`(cons "--with-x-toolkit=no" ,flags))))))
;;; ;;;
;;; Emacs hacking. ;;; Emacs hacking.
@ -110,13 +131,13 @@ languages.")
(define-public geiser (define-public geiser
(package (package
(name "geiser") (name "geiser")
(version "0.4") (version "0.6")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://savannah/geiser/" version (uri (string-append "mirror://savannah/geiser/" version
"/geiser-" version ".tar.gz")) "/geiser-" version ".tar.gz"))
(sha256 (sha256
(base32 "0ds7zk9b1839l9fsqfsgrby6manvy1cf5bjniiqhxl55h0cr6ijp")))) (base32 "1mrk0bzqcpfhsw6635qznn47nzfy9ps7wrhkpymswdfpw5mdsry5"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs `(("guile" ,guile-2.0) (inputs `(("guile" ,guile-2.0)
("emacs" ,emacs))) ("emacs" ,emacs)))
@ -138,3 +159,212 @@ of the stage in Geiser. A bundle of Elisp shims orchestrates the dialog
between the Scheme interpreter, Emacs and, ultimately, the schemer, between the Scheme interpreter, Emacs and, ultimately, the schemer,
giving her access to live metadata.") giving her access to live metadata.")
(license bsd-3))) (license bsd-3)))
(define-public paredit
(package
(name "paredit")
(version "23")
(source (origin
(method url-fetch)
(uri (string-append "http://mumble.net/~campbell/emacs/paredit-"
version ".el"))
(sha256
(base32 "1np882jzvxckljx3cjz4absyzmc5hw65cs21sjmbic82163m9lf8"))))
(build-system trivial-build-system)
(inputs `(("emacs" ,emacs)))
(arguments
`(#:modules ((guix build utils)
(guix build emacs-utils))
#:builder
(begin
(use-modules (guix build utils))
(use-modules (guix build emacs-utils))
(let* ((emacs (string-append (assoc-ref %build-inputs "emacs")
"/bin/emacs"))
(source (assoc-ref %build-inputs "source"))
(lisp-dir (string-append %output
"/share/emacs/site-lisp"))
(target (string-append lisp-dir "/paredit.el")))
(mkdir-p lisp-dir)
(copy-file source target)
(with-directory-excursion lisp-dir
(parameterize ((%emacs emacs))
(emacs-batch-eval '(byte-compile-file "paredit.el"))))))))
(home-page "http://mumble.net/~campbell/emacs/paredit/")
(synopsis "Emacs minor mode for editing parentheses")
(description
"ParEdit (paredit.el) is a minor mode for performing structured editing
of S-expression data. The typical example of this would be Lisp or Scheme
source code.
ParEdit helps **keep parentheses balanced** and adds many keys for moving
S-expressions and moving around in S-expressions. Its behavior can be jarring
for those who may want transient periods of unbalanced parentheses, such as
when typing parentheses directly or commenting out code line by line.")
(license gpl3+)))
(define-public magit
(package
(name "magit")
(version "1.2.0")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/downloads/magit/magit/magit-"
version ".tar.gz"))
(sha256
(base32 "1a8vvilhd5y5vmlpsh194qpl4qlg0a1brylfscxcacpfp0cmhlzg"))))
(build-system gnu-build-system)
(native-inputs `(("texinfo" ,texinfo)))
(inputs `(("emacs" ,emacs)
("git" ,git)
("git:gui" ,git "gui")))
(arguments
`(#:modules ((guix build gnu-build-system)
(guix build utils)
(guix build emacs-utils))
#:imported-modules ((guix build gnu-build-system)
(guix build utils)
(guix build emacs-utils))
#:tests? #f ; no check target
#:phases
(alist-replace
'configure
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(substitute* "Makefile"
(("/usr/local") out)
(("/etc") (string-append out "/etc")))))
(alist-cons-before
'build 'patch-exec-paths
(lambda* (#:key inputs #:allow-other-keys)
(let ((git (assoc-ref inputs "git"))
(git:gui (assoc-ref inputs "git:gui")))
(emacs-substitute-variables "magit.el"
("magit-git-executable" (string-append git "/bin/git"))
("magit-gitk-executable" (string-append git:gui "/bin/gitk")))))
%standard-phases))))
(home-page "http://magit.github.io/")
(synopsis "Emacs interface for the Git version control system")
(description
"With Magit, you can inspect and modify your Git repositories with Emacs.
You can review and commit the changes you have made to the tracked files, for
example, and you can browse the history of past changes. There is support for
cherry picking, reverting, merging, rebasing, and other common Git
operations.")
(license gpl3+)))
;;;
;;; Web browsing.
;;;
(define-public emacs-w3m
(package
(name "emacs-w3m")
(version "1.4.483+0.20120614")
(source (origin
(method url-fetch)
(uri (string-append "mirror://debian/pool/main/w/w3m-el/w3m-el_"
version ".orig.tar.gz"))
(sha256
(base32 "0ms181gjavnfk79hhv5xl9llik4c6kj0w3c04kgyif8lcy2sxljx"))))
(build-system gnu-build-system)
(native-inputs `(("autoconf" ,autoconf)))
(inputs `(("w3m" ,w3m)
("imagemagick" ,imagemagick)
("emacs" ,emacs)))
(arguments
'(#:modules ((guix build gnu-build-system)
(guix build utils)
(guix build emacs-utils))
#:imported-modules ((guix build gnu-build-system)
(guix build utils)
(guix build emacs-utils))
#:configure-flags
(let ((out (assoc-ref %outputs "out")))
(list (string-append "--with-lispdir="
out "/share/emacs/site-lisp")
(string-append "--with-icondir="
out "/share/images/emacs-w3m")))
#:tests? #f ; no check target
#:phases
(alist-cons-before
'configure 'pre-configure
(lambda _
(zero? (system* "autoconf")))
(alist-cons-before
'build 'patch-exec-paths
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out"))
(w3m (assoc-ref inputs "w3m"))
(imagemagick (assoc-ref inputs "imagemagick"))
(coreutils (assoc-ref inputs "coreutils")))
(emacs-substitute-variables "w3m.el"
("w3m-command" (string-append w3m "/bin/w3m"))
("w3m-touch-command" (string-append coreutils "/bin/touch"))
("w3m-image-viewer" (string-append imagemagick "/bin/display"))
("w3m-icon-directory" (string-append out
"/share/images/emacs-w3m")))
(emacs-substitute-variables "w3m-image.el"
("w3m-imagick-convert-program" (string-append imagemagick
"/bin/convert"))
("w3m-imagick-identify-program" (string-append imagemagick
"/bin/identify")))
#t))
(alist-replace
'install
(lambda* (#:key outputs #:allow-other-keys)
(and (zero? (system* "make" "install" "install-icons"))
(with-directory-excursion
(string-append (assoc-ref outputs "out")
"/share/emacs/site-lisp")
(for-each delete-file '("ChangeLog" "ChangeLog.1"))
#t)))
%standard-phases)))))
(home-page "http://emacs-w3m.namazu.org/")
(synopsis "Simple Web browser for Emacs based on w3m")
(description
"emacs-w3m is an emacs interface for the w3m web browser.")
(license gpl2+)))
(define-public emacs-wget
(package
(name "emacs-wget")
(version "0.5.0")
(source (origin
(method url-fetch)
(uri (string-append "mirror://debian/pool/main/w/wget-el/wget-el_"
version ".orig.tar.gz"))
(sha256
(base32 "10byvyv9dk0ib55gfqm7bcpxmx2qbih1jd03gmihrppr2mn52nff"))))
(build-system gnu-build-system)
(inputs `(("wget" ,wget)
("emacs" ,emacs)))
(arguments
'(#:modules ((guix build gnu-build-system)
(guix build utils)
(guix build emacs-utils))
#:imported-modules ((guix build gnu-build-system)
(guix build utils)
(guix build emacs-utils))
#:tests? #f ; no check target
#:phases
(alist-replace
'configure
(lambda* (#:key outputs #:allow-other-keys)
(substitute* "Makefile"
(("/usr/local") (assoc-ref outputs "out"))
(("/site-lisp/emacs-wget") "/site-lisp")))
(alist-cons-before
'build 'patch-exec-paths
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((wget (assoc-ref inputs "wget")))
(emacs-substitute-variables "wget.el"
("wget-command" (string-append wget "/bin/wget")))))
%standard-phases))))
(home-page "http://www.emacswiki.org/emacs/EmacsWget")
(synopsis "Simple file downloader for Emacs based on wget")
(description
"emacs-wget is an emacs interface for the wget file downloader.")
(license gpl2+)))

View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014 Guy Grant <tadnimi@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -22,10 +23,14 @@
#:renamer (symbol-prefix-proc 'license:)) #:renamer (symbol-prefix-proc 'license:))
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix download) #:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (guix build-system trivial) #:use-module (guix build-system trivial)
#:use-module ((gnu packages base) #:use-module ((gnu packages base)
#:select (tar)) #:select (tar))
#:use-module (gnu packages compression)) #:use-module (gnu packages compression)
#:use-module (gnu packages perl)
#:use-module (gnu packages xorg)
#:use-module (gnu packages pkg-config))
(define-public ttf-dejavu (define-public ttf-dejavu
(package (package
@ -198,3 +203,41 @@ package provides the TrueType (TTF) files.")
(PostScript Type0, TrueType, OpenType...) fonts covering the ISO (PostScript Type0, TrueType, OpenType...) fonts covering the ISO
10646/Unicode UCS (Universal Character Set).") 10646/Unicode UCS (Universal Character Set).")
(license license:gpl3+))) (license license:gpl3+)))
(define-public terminus-font
(package
(name "terminus-font")
(version "4.39")
(source
(origin
(method url-fetch)
(uri (string-append
"mirror://sourceforge/project/terminus-font/terminus-font-"
version
"/terminus-font-"
version
".tar.gz"))
(sha256
(base32
"1gzmn7zakvy6yrvmswyjfklnsvqrjm0imhq8rjws8rdkhqwkh21i"))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)
("perl" ,perl)
("bdftopcf" ,bdftopcf)
("font-util", font-util)
("mkfontdir" ,mkfontdir)))
(arguments
`(#:configure-flags (list
;; install fonts into subdirectory of package output
;; instead of font-util-?.?.?/share/fonts/X11
(string-append "--with-fontrootdir="
%output "/share/fonts/X11"))
#:tests? #f)) ;; No test target in tarball
(home-page "http://terminus-font.sourceforge.net/")
(synopsis "Simple bitmap programming font")
(description "Terminus Font is a clean, fixed width bitmap font, designed
for long (8 and more hours per day) work with computers.")
(license
(license:x11-style
"http://scripts.sil.org/cms/scripts/page.php?item_id=OFL_web"))))

View File

@ -136,13 +136,13 @@ and support for SSL3 and TLS.")
(define-public gnurl (define-public gnurl
(package (package
(name "gnurl") (name "gnurl")
(version "7.35.0") (version "7.37.0")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://gnunet.org/sites/default/files/gnurl-" (uri (string-append "https://gnunet.org/sites/default/files/gnurl-"
version ".tar.bz2")) version ".tar.gz"))
(sha256 (sha256
(base32 "0dzj22f5z6ppjj1aq1bml64iwbzzcd8w1qy3bgpk6gnzqslsxknf")))) (base32 "1l2q9ih63vkm65zn886kmhqsx906pzx3qjvsxymlmf18kiv18pfd"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs `(("gnutls" ,gnutls) (inputs `(("gnutls" ,gnutls)
("libidn" ,libidn) ("libidn" ,libidn)

View File

@ -168,14 +168,14 @@ specifications are building blocks of S/MIME and TLS.")
(define-public gnupg (define-public gnupg
(package (package
(name "gnupg") (name "gnupg")
(version "2.0.25") (version "2.0.26")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnupg/gnupg/gnupg-" version (uri (string-append "mirror://gnupg/gnupg/gnupg-" version
".tar.bz2")) ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"08sqdkybgw4jkdkcyz1bi6y8irj87hpr5b12lkb57kwny1yykaxk")))) "1q5qcl5panrvcvpwvz6nl9gayl5a6vwvfhgdcxqpmbl2qc6y6n3p"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs (inputs
`(("bzip2" ,guix:bzip2) `(("bzip2" ,guix:bzip2)
@ -234,7 +234,7 @@ libskba (working with X.509 certificates and CMS data).")
(define-public gpgme (define-public gpgme
(package (package
(name "gpgme") (name "gpgme")
(version "1.4.3") (version "1.5.1")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -242,7 +242,7 @@ libskba (working with X.509 certificates and CMS data).")
".tar.bz2")) ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"15h429h6pd67iiv580bjmwbkadpxsdppw0xrqpcm4dvm24jc271d")))) "1qqi9bxwxxsc4r15j7drclgp0w8jk9nj3h2fsivk4c7brvw3lbvc"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(propagated-inputs (propagated-inputs
;; Needs to be propagated because gpgme.h includes gpg-error.h. ;; Needs to be propagated because gpgme.h includes gpg-error.h.
@ -250,6 +250,7 @@ libskba (working with X.509 certificates and CMS data).")
(inputs (inputs
`(("gnupg" ,gnupg) `(("gnupg" ,gnupg)
("libassuan" ,libassuan))) ("libassuan" ,libassuan)))
(arguments '(#:make-flags '("GPG=gpg2")))
(home-page "http://www.gnupg.org/related_software/gpgme/") (home-page "http://www.gnupg.org/related_software/gpgme/")
(synopsis "library providing simplified access to GnuPG functionality") (synopsis "library providing simplified access to GnuPG functionality")
(description (description

View File

@ -327,14 +327,14 @@ for Guile\".")
(define-public guile-json (define-public guile-json
(package (package
(name "guile-json") (name "guile-json")
(version "0.3.1") (version "0.4.0")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://savannah/guile-json/guile-json-" (uri (string-append "mirror://savannah/guile-json/guile-json-"
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0nz2sx61kd6cfflwzxxq0cb9dz0asb81abbhfawv4p9ghciqdr3g")) "0v06272rw4ycwzssjf3fzpk2vhpslvl55hz94q80vc6f74j0d5h6"))
(modules '((guix build utils))) (modules '((guix build utils)))
(snippet (snippet
;; Make sure everything goes under .../site/2.0, like Guile's ;; Make sure everything goes under .../site/2.0, like Guile's

View File

@ -37,12 +37,12 @@
(base32 (base32
"088yh8pxd6q53ssqndydcw1dkq51cjqyahc03lm6iip22cdazcf0")))) "088yh8pxd6q53ssqndydcw1dkq51cjqyahc03lm6iip22cdazcf0"))))
(build-system cmake-build-system) (build-system cmake-build-system)
(native-inputs (inputs
`(("libusb" ,libusb))) `(("libusb" ,libusb)))
(home-page "http://www.intra2net.com") (home-page "http://www.intra2net.com/en/developer/libftdi/")
(synopsis "FTDI USB driver with bitbang mode") (synopsis "FTDI USB driver with bitbang mode")
(description (description
"libFTDI is a library to talk to FTDI chips: FT232BM, "libFTDI is a library to talk to FTDI chips: FT232BM,
FT245BM, FT2232C, FT2232D, FT245R and FT232H including the popular FT245BM, FT2232C, FT2232D, FT245R and FT232H including the popular
bitbangmode.") bitbangmode.")
(license lgpl2.1+))) (license lgpl2.1)))

View File

@ -25,14 +25,14 @@
(define-public lightning (define-public lightning
(package (package
(name "lightning") (name "lightning")
(version "2.0.4") (version "2.0.5")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnu/lightning/lightning-" (uri (string-append "mirror://gnu/lightning/lightning-"
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1lrckrx51d5hrv66bc99fd4b7g2wwn4vr304hwq3glfzhb8jqcdy")))) "0jm9a8ddxc1v9hyzyv4ybg37fjac2yjqv1hkd262wxzqms36mdk5"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(synopsis "Library for generating assembly code at runtime") (synopsis "Library for generating assembly code at runtime")
(description (description

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;; ;;;
@ -23,8 +23,7 @@
#:use-module ((guix licenses) #:use-module ((guix licenses)
#:hide (zlib)) #:hide (zlib))
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module ((gnu packages compression) #:use-module ((gnu packages compression) #:prefix guix:)
#:renamer (symbol-prefix-proc 'guix:))
#:use-module (gnu packages flex) #:use-module (gnu packages flex)
#:use-module (gnu packages bison) #:use-module (gnu packages bison)
#:use-module (gnu packages gperf) #:use-module (gnu packages gperf)
@ -44,6 +43,10 @@
#:use-module (gnu packages autotools) #:use-module (gnu packages autotools)
#:use-module (gnu packages texinfo) #:use-module (gnu packages texinfo)
#:use-module (gnu packages check) #:use-module (gnu packages check)
#:use-module (gnu packages maths)
#:use-module (gnu packages which)
#:use-module (gnu packages rrdtool)
#:use-module (gnu packages gtk)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix download) #:use-module (guix download)
#:use-module (guix build-system gnu) #:use-module (guix build-system gnu)
@ -165,7 +168,7 @@
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "http://www.fsfla.org/svn/fsfla/software/linux-libre/" (uri (string-append "http://www.fsfla.org/svn/fsfla/software/linux-libre/"
"lemote/gnewsense/branches/3.15/100gnu+freedo.patch")) "lemote/gnewsense/branches/3.16/100gnu+freedo.patch"))
(sha256 (sha256
(base32 (base32
"1hk9swxxc80bmn2zd2qr5ccrjrk28xkypwhl4z0qx4hbivj7qm06")))) "1hk9swxxc80bmn2zd2qr5ccrjrk28xkypwhl4z0qx4hbivj7qm06"))))
@ -186,7 +189,7 @@ for SYSTEM, or #f if there is no configuration for SYSTEM."
#f))) #f)))
(define-public linux-libre (define-public linux-libre
(let* ((version "3.15.8") (let* ((version "3.16.1")
(build-phase (build-phase
'(lambda* (#:key system inputs #:allow-other-keys #:rest args) '(lambda* (#:key system inputs #:allow-other-keys #:rest args)
;; Apply the neat patch. ;; Apply the neat patch.
@ -259,7 +262,7 @@ for SYSTEM, or #f if there is no configuration for SYSTEM."
(uri (linux-libre-urls version)) (uri (linux-libre-urls version))
(sha256 (sha256
(base32 (base32
"1ichq7b08rrfq61i8kpan9vxw9mxcfpcl8cw0a6lbc1ycwzvm7xw")))) "1x4y0017l4ndcab4smky2wx0n86r3wyks2r8yyp19ia9ccnl98mf"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs `(("perl" ,perl) (native-inputs `(("perl" ,perl)
("bc" ,bc) ("bc" ,bc)
@ -1341,6 +1344,65 @@ device nodes from /dev/, handles hotplug events and loads drivers at boot
time.") time.")
(license gpl2+))) ; libudev is under lgpl2.1+ (license gpl2+))) ; libudev is under lgpl2.1+
(define-public lvm2
(package
(name "lvm2")
(version "2.02.109")
(source (origin
(method url-fetch)
(uri (string-append "ftp://sources.redhat.com/pub/lvm2/releases/LVM2."
version ".tgz"))
(sha256
(base32
"1rv5ivg0l1w3nwzwdkqixm96h5bzg7ib4rr196ysb2lw42jmpjbv"))
(modules '((guix build utils)))
(snippet
'(begin
(use-modules (guix build utils))
;; Honor sysconfdir.
(substitute* "make.tmpl.in"
(("confdir = .*$")
"confdir = @sysconfdir@\n")
(("DEFAULT_SYS_DIR = @DEFAULT_SYS_DIR@")
"DEFAULT_SYS_DIR = @sysconfdir@"))))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)
("procps" ,procps))) ;tests use 'pgrep'
(inputs
`(("udev" ,udev)))
(arguments
'(#:phases (alist-cons-after
'configure 'set-makefile-shell
(lambda _
;; Use 'sh', not 'bash', so that '. lib/utils.sh' works as
;; expected.
(setenv "SHELL" (which "sh"))
;; Replace /bin/sh with the right file name.
(patch-makefile-SHELL "make.tmpl"))
%standard-phases)
#:configure-flags (list (string-append "--sysconfdir="
(assoc-ref %outputs "out")
"/etc/lvm")
"--enable-udev_sync"
"--enable-udev_rules")
;; The tests use 'mknod', which requires root access.
#:tests? #f))
(home-page "http://sourceware.org/lvm2/")
(synopsis "Logical volume management for Linux")
(description
"LVM2 is the logical volume management tool set for Linux-based systems.
This package includes the user-space libraries and tools, including the device
mapper. Kernel components are part of Linux-libre.")
;; Libraries (liblvm2, libdevmapper) are LGPLv2.1.
;; Command-line tools are GPLv2.
(license (list gpl2 lgpl2.1))))
(define-public wireless-tools (define-public wireless-tools
(package (package
(name "wireless-tools") (name "wireless-tools")
@ -1366,3 +1428,113 @@ Extensions. The Wireless Extension is an interface allowing you to set
Wireless LAN specific parameters and get the specific stats.") Wireless LAN specific parameters and get the specific stats.")
(home-page "http://www.hpl.hp.com/personal/Jean_Tourrilhes/Linux/Tools.html") (home-page "http://www.hpl.hp.com/personal/Jean_Tourrilhes/Linux/Tools.html")
(license gpl2+))) (license gpl2+)))
(define-public lm-sensors
(package
(name "lm-sensors")
(version "3.3.5")
(source (origin
(method url-fetch)
(uri (string-append
"http://dl.lm-sensors.org/lm-sensors/releases/lm_sensors-"
version ".tar.bz2"))
(sha256
(base32
"1ksgrynxgrq590nb2fwxrl1gwzisjkqlyg3ljfd1al0ibrk6mbjx"))
(patches (list (search-patch "lm-sensors-hwmon-attrs.patch")))))
(build-system gnu-build-system)
(inputs `(("rrdtool" ,rrdtool)
("perl" ,perl)
("kmod" ,kmod)
("gnuplot" ,gnuplot)))
(native-inputs `(("pkg-config" ,pkg-config)
("flex" ,flex)
("bison" ,bison)
("which" ,which)))
(arguments
`(#:tests? #f ; no 'check' target
#:make-flags (list (string-append "PREFIX=" %output)
(string-append "ETCDIR=" %output "/etc")
(string-append "MANDIR=" %output "/share/man"))
#:phases
(alist-delete
'configure
(alist-cons-before
'build 'patch-exec-paths
(lambda* (#:key inputs outputs #:allow-other-keys)
(substitute* "prog/detect/sensors-detect"
(("`uname")
(string-append "`" (assoc-ref inputs "coreutils")
"/bin/uname"))
(("(`|\")modprobe" all open-quote)
(string-append open-quote
(assoc-ref inputs "kmod")
"/bin/modprobe")))
(substitute* '("prog/pwm/pwmconfig"
"prog/pwm/fancontrol")
(("gnuplot")
(string-append (assoc-ref inputs "gnuplot")
"/bin/gnuplot"))
(("cat ")
(string-append (assoc-ref inputs "coreutils")
"/bin/cat "))
(("egrep ")
(string-append (assoc-ref inputs "grep")
"/bin/egrep "))
(("sed -e")
(string-append (assoc-ref inputs "sed")
"/bin/sed -e"))
(("cut -d")
(string-append (assoc-ref inputs "coreutils")
"/bin/cut -d"))
(("sleep ")
(string-append (assoc-ref inputs "coreutils")
"/bin/sleep "))
(("readlink -f")
(string-append (assoc-ref inputs "coreutils")
"/bin/readlink -f"))))
%standard-phases))))
(home-page "http://www.lm-sensors.org/")
(synopsis "Utilities to read temperature/voltage/fan sensors")
(description
"lm-sensors is a hardware health monitoring package for Linux. It allows
you to access information from temperature, voltage, and fan speed sensors.
It works with most newer systems.")
(license gpl2+)))
(define-public xsensors
(package
(name "xsensors")
(version "0.70")
(source (origin
(method url-fetch)
(uri (string-append
"http://www.linuxhardware.org/xsensors/xsensors-"
version ".tar.gz"))
(sha256
(base32
"1siplsfgvcxamyqf44h71jx6jdfmvhfm7mh0y1q8ps4zs6pj2zwh"))))
(build-system gnu-build-system)
(inputs `(("lm-sensors" ,lm-sensors)
("gtk" ,gtk+-2)))
(native-inputs `(("pkg-config" ,pkg-config)))
(arguments
`(#:phases (alist-cons-before
'configure 'enable-deprecated
(lambda _
(substitute* "src/Makefile.in"
(("-DGDK_DISABLE_DEPRECATED") "")
(("-DGTK_DISABLE_DEPRECATED") "")))
(alist-cons-before
'configure 'remove-Werror
(lambda _
(substitute* '("configure" "src/Makefile.in")
(("-Werror") "")))
%standard-phases))))
(home-page "http://www.linuxhardware.org/xsensors/")
(synopsis "Hardware health information viewer")
(description
"xsensors reads data from the libsensors library regarding hardware
health such as temperature, voltage and fan speed and displays the information
in a digital read-out.")
(license gpl2+)))

View File

@ -1,62 +0,0 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages lvm)
#:use-module ((guix licenses)
#:renamer (symbol-prefix-proc 'license:))
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (gnu packages)
#:use-module (gnu packages linux)
#:use-module (gnu packages pkg-config))
(define-public lvm2
(package
(name "lvm2")
(version "2.02.98")
(source (origin
(method url-fetch)
(uri (string-append "ftp://sources.redhat.com/pub/lvm2/LVM2."
version ".tgz"))
(sha256
(base32
"0r6q6z8ip6q5qgkzng0saljassp4912k6i21ra10vq7pzrc0l0vi"))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)
("procps" ,procps)))
(arguments
`(#:tests? #f ; require to be root
#:configure-flags
`(,(string-append "--with-confdir=" (assoc-ref %outputs "out") "/etc"))
#:phases
(alist-cons-before
'configure 'patch-make-tmpl
(lambda _
(substitute* "make.tmpl.in"
(("/bin/sh") (which "sh"))
(("CC \\?=") "CC ="))) ; force CC argument to be set from configure
%standard-phases)))
(synopsis "logical volume management")
(description
"LVM2 refers to the userspace toolset that provides logical volume
management facilities on linux. It is reasonably backwards-compatible with
the original LVM toolset.")
(license license:gpl2)
(home-page "http://www.sourceware.org/lvm2/")))

View File

@ -132,7 +132,7 @@ software.")
`(#:configure-flags (list (string-append "--with-ssl=" `(#:configure-flags (list (string-append "--with-ssl="
(assoc-ref %build-inputs "openssl"))))) (assoc-ref %build-inputs "openssl")))))
(home-page "http://fetchmail.berlios.de/") (home-page "http://fetchmail.berlios.de/")
(synopsis "Remote-mailr etrieval and forwarding utility") (synopsis "Remote-mail retrieval and forwarding utility")
(description (description
"Fetchmail is a full-featured, robust, well-documented remote-mail "Fetchmail is a full-featured, robust, well-documented remote-mail
retrieval and forwarding utility intended to be used over on-demand retrieval and forwarding utility intended to be used over on-demand
@ -332,14 +332,14 @@ attachments, create new maildirs, and so on.")
(define-public notmuch (define-public notmuch
(package (package
(name "notmuch") (name "notmuch")
(version "0.18") (version "0.18.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "http://notmuchmail.org/releases/notmuch-" (uri (string-append "http://notmuchmail.org/releases/notmuch-"
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1ia65iazz2hlp3ja57yn0chs27rzsky9kayw74njwmgi9faw3vh9")))) "1pdp9l7yv71d3fjb30qyccva8h03hvg88q4a00yi50v2j70kvmgj"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
'(#:tests? #f ;; FIXME: Test suite hangs and times out. '(#:tests? #f ;; FIXME: Test suite hangs and times out.

View File

@ -31,15 +31,15 @@
(define-public mysql (define-public mysql
(package (package
(name "mysql") (name "mysql")
(version "5.1.54") (version "5.1.73")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
"http://downloads.mysql.com/archives/mysql-5.1/mysql-" "http://dev.mysql.com/get/Downloads/MySQL-5.1/mysql-"
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"07xbnwk7h1xya8s6dw34nrv7ampzag8l0l1szd2pc9zyqkzhydw4")))) "1dfwi4ck0vq6sdci6gz0031s7zz5lc3pddqlgm0292s00l9y5sq5"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs (inputs
`(("procps" ,procps) `(("procps" ,procps)

View File

@ -28,14 +28,14 @@
(define-public openssl (define-public openssl
(package (package
(name "openssl") (name "openssl")
(version "1.0.1h") (version "1.0.1i")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "ftp://ftp.openssl.org/source/openssl-" version (uri (string-append "ftp://ftp.openssl.org/source/openssl-" version
".tar.gz")) ".tar.gz"))
(sha256 (sha256
(base32 (base32
"14yhsgag5as7nhxnw7f0vklwjwa3pmn1i15nmp3f4qxa6sc8l74x")))) "1izwv1wzqdw8aqnvb70jcqpqp0rvkcm22w5c1dm9l1kpr939y5rw"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs `(("perl" ,perl))) (native-inputs `(("perl" ,perl)))
(arguments (arguments

96
gnu/packages/orpheus.scm Normal file
View File

@ -0,0 +1,96 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages orpheus)
#:use-module (guix licenses)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (gnu packages)
#:use-module (gnu packages ncurses)
#:use-module (gnu packages mp3)
#:use-module (gnu packages which)
#:use-module (gnu packages xiph)
#:use-module (gnu packages xml))
(define-public orpheus
(package
(name "orpheus")
(version "1.6")
(source
(origin
(method url-fetch)
(uri (string-append "http://thekonst.net/download/orpheus-"
version ".tar.gz"))
(sha256
(base32
"1xbgxq8fybwhm51nw9hvvrgi873qzkc2qvmy15d2m2hw2yqa99hq"))
(patches (list (search-patch "orpheus-cast-errors-and-includes.patch")))))
(build-system gnu-build-system)
(inputs
`(("ncurses" ,ncurses)
("libvorbis" ,libvorbis)
("vorbis-tools" ,vorbis-tools)
("mpg321" ,mpg321)
;; TODO: add ghttp
("libxml2" ,libxml2)
("which" ,which)))
(arguments
`(#:phases
(alist-replace
'configure
(lambda* (#:key outputs #:allow-other-keys)
;; This old `configure' script does not support variables passed as
;; arguments.
(let ((out (assoc-ref outputs "out")))
(setenv "CONFIG_SHELL" (which "bash"))
(setenv "SHELL" (which "bash"))
(setenv "LIBS" "-logg") ;doesn't declare its use of libogg
(zero?
(system* "./configure" (string-append "--prefix=" out)))))
(alist-cons-after
'configure 'configure-players
(lambda* (#:key inputs #:allow-other-keys)
;; To avoid propagating the mpg321 and vorbis-tools inputs, we can
;; make the orpheus application execute the needed players from the
;; store.
(let ((ogg123 (string-append (assoc-ref inputs "vorbis-tools")
"/bin/ogg123"))
(mpg321 (string-append (assoc-ref inputs "mpg321")
"/bin/mpg321"))
(which (string-append (assoc-ref inputs "which")
"/bin/which")))
(substitute* "src/orpheusconf.cc"
(("ogg123") ogg123)
(("which") which)
(("mpg321") mpg321))))
(alist-cons-before
'build 'patch-shells
(lambda _
(substitute* '("src/mp3track.cc"
"src/streamtrack.cc"
"src/oggtrack.cc")
(("/bin/sh") (which "bash"))))
%standard-phases)))))
(home-page "http://thekonst.net/en/orpheus")
(synopsis "Text-mode audio player")
(description
"Orpheus is a light-weight text mode menu- and window-driven audio player
application for CDs, internet stream broadcasts, and files in MP3 and Vorbis
OGG format.")
(license gpl2+)))

View File

@ -0,0 +1,256 @@
Avrdude cannot build with our version of libusb. This patch fixes that.
See http://savannah.nongnu.org/bugs/?41854
diff --git a/dfu.c b/dfu.c
index 7d349bc..0f80440 100644
--- a/dfu.c
+++ b/dfu.c
@@ -36,13 +36,14 @@
#ifndef HAVE_LIBUSB
-int dfu_open(struct dfu_dev *dfu, char *port_name) {
+struct dfu_dev * dfu_open(char *port_spec) {
fprintf(stderr, "%s: Error: No USB support in this compile of avrdude\n",
progname);
- return -1;
+ return NULL;
}
-int dfu_init(struct dfu_dev *dfu, unsigned short usb_pid) {
+int dfu_init(struct dfu_dev *dfu,
+ unsigned short vid, unsigned short pid) {
return -1;
}
diff --git a/flip1.c b/flip1.c
index b891d80..0959996 100644
--- a/flip1.c
+++ b/flip1.c
@@ -164,6 +164,8 @@ static void flip1_setup(PROGRAMMER * pgm);
static void flip1_teardown(PROGRAMMER * pgm);
/* INTERNAL PROGRAMMER FUNCTION PROTOTYPES */
+#ifdef HAVE_LIBUSB
+// The internal ones are made conditional, as they're not defined further down #ifndef HAVE_LIBUSB
static void flip1_show_info(struct flip1 *flip1);
@@ -177,6 +179,8 @@ static const char * flip1_mem_unit_str(enum flip1_mem_unit mem_unit);
static int flip1_set_mem_page(struct dfu_dev *dfu, unsigned short page_addr);
static enum flip1_mem_unit flip1_mem_unit(const char *name);
+#endif /* HAVE_LIBUSB */
+
/* THE INITPGM FUNCTION DEFINITIONS */
void flip1_initpgm(PROGRAMMER *pgm)
@@ -201,6 +205,7 @@ void flip1_initpgm(PROGRAMMER *pgm)
pgm->teardown = flip1_teardown;
}
+#ifdef HAVE_LIBUSB
/* EXPORTED PROGRAMMER FUNCTION DEFINITIONS */
int flip1_open(PROGRAMMER *pgm, char *port_spec)
@@ -876,3 +881,82 @@ enum flip1_mem_unit flip1_mem_unit(const char *name) {
return FLIP1_MEM_UNIT_EEPROM;
return FLIP1_MEM_UNIT_UNKNOWN;
}
+#else /* HAVE_LIBUSB */
+// Dummy functions
+int flip1_open(PROGRAMMER *pgm, char *port_spec)
+{
+ fprintf(stderr, "%s: Error: No USB support in this compile of avrdude\n",
+ progname);
+ return NULL;
+}
+
+int flip1_initialize(PROGRAMMER* pgm, AVRPART *part)
+{
+ return -1;
+}
+
+void flip1_close(PROGRAMMER* pgm)
+{
+}
+
+void flip1_enable(PROGRAMMER* pgm)
+{
+}
+
+void flip1_disable(PROGRAMMER* pgm)
+{
+}
+
+void flip1_display(PROGRAMMER* pgm, const char *prefix)
+{
+}
+
+int flip1_program_enable(PROGRAMMER* pgm, AVRPART *part)
+{
+ return -1;
+}
+
+int flip1_chip_erase(PROGRAMMER* pgm, AVRPART *part)
+{
+ return -1;
+}
+
+int flip1_read_byte(PROGRAMMER* pgm, AVRPART *part, AVRMEM *mem,
+ unsigned long addr, unsigned char *value)
+{
+ return -1;
+}
+
+int flip1_write_byte(PROGRAMMER* pgm, AVRPART *part, AVRMEM *mem,
+ unsigned long addr, unsigned char value)
+{
+ return -1;
+}
+
+int flip1_paged_load(PROGRAMMER* pgm, AVRPART *part, AVRMEM *mem,
+ unsigned int page_size, unsigned int addr, unsigned int n_bytes)
+{
+ return -1;
+}
+
+int flip1_paged_write(PROGRAMMER* pgm, AVRPART *part, AVRMEM *mem,
+ unsigned int page_size, unsigned int addr, unsigned int n_bytes)
+{
+ return -1;
+}
+
+int flip1_read_sig_bytes(PROGRAMMER* pgm, AVRPART *part, AVRMEM *mem)
+{
+ return -1;
+}
+
+void flip1_setup(PROGRAMMER * pgm)
+{
+}
+
+void flip1_teardown(PROGRAMMER * pgm)
+{
+}
+
+
+#endif /* HAVE_LIBUSB */
\ No newline at end of file
diff --git a/flip2.c b/flip2.c
index ed8e996..16c4bf8 100644
--- a/flip2.c
+++ b/flip2.c
@@ -151,6 +151,8 @@ static void flip2_setup(PROGRAMMER * pgm);
static void flip2_teardown(PROGRAMMER * pgm);
/* INTERNAL PROGRAMMER FUNCTION PROTOTYPES */
+#ifdef HAVE_LIBUSB
+// The internal ones are made conditional, as they're not defined further down #ifndef HAVE_LIBUSB
static void flip2_show_info(struct flip2 *flip2);
@@ -171,6 +173,8 @@ static const char * flip2_status_str(const struct dfu_status *status);
static const char * flip2_mem_unit_str(enum flip2_mem_unit mem_unit);
static enum flip2_mem_unit flip2_mem_unit(const char *name);
+#endif /* HAVE_LIBUSB */
+
/* THE INITPGM FUNCTION DEFINITIONS */
void flip2_initpgm(PROGRAMMER *pgm)
@@ -195,6 +199,7 @@ void flip2_initpgm(PROGRAMMER *pgm)
pgm->teardown = flip2_teardown;
}
+#ifdef HAVE_LIBUSB
/* EXPORTED PROGRAMMER FUNCTION DEFINITIONS */
int flip2_open(PROGRAMMER *pgm, char *port_spec)
@@ -922,3 +927,85 @@ enum flip2_mem_unit flip2_mem_unit(const char *name) {
return FLIP2_MEM_UNIT_SIGNATURE;
return FLIP2_MEM_UNIT_UNKNOWN;
}
+
+#else /* HAVE_LIBUSB */
+
+/* EXPORTED PROGRAMMER FUNCTION DEFINITIONS */
+
+int flip2_open(PROGRAMMER *pgm, char *port_spec)
+{
+ fprintf(stderr, "%s: Error: No USB support in this compile of avrdude\n",
+ progname);
+ return NULL;
+}
+
+int flip2_initialize(PROGRAMMER* pgm, AVRPART *part)
+{
+ return -1;
+}
+
+void flip2_close(PROGRAMMER* pgm)
+{
+}
+
+void flip2_enable(PROGRAMMER* pgm)
+{
+}
+
+void flip2_disable(PROGRAMMER* pgm)
+{
+}
+
+void flip2_display(PROGRAMMER* pgm, const char *prefix)
+{
+}
+
+int flip2_program_enable(PROGRAMMER* pgm, AVRPART *part)
+{
+ return -1;
+}
+
+int flip2_chip_erase(PROGRAMMER* pgm, AVRPART *part)
+{
+ return -1;
+}
+
+int flip2_read_byte(PROGRAMMER* pgm, AVRPART *part, AVRMEM *mem,
+ unsigned long addr, unsigned char *value)
+{
+ return -1;
+}
+
+int flip2_write_byte(PROGRAMMER* pgm, AVRPART *part, AVRMEM *mem,
+ unsigned long addr, unsigned char value)
+{
+ return -1;
+}
+
+int flip2_paged_load(PROGRAMMER* pgm, AVRPART *part, AVRMEM *mem,
+ unsigned int page_size, unsigned int addr, unsigned int n_bytes)
+{
+ return -1;
+}
+
+int flip2_paged_write(PROGRAMMER* pgm, AVRPART *part, AVRMEM *mem,
+ unsigned int page_size, unsigned int addr, unsigned int n_bytes)
+{
+ return -1;
+}
+
+int flip2_read_sig_bytes(PROGRAMMER* pgm, AVRPART *part, AVRMEM *mem)
+{
+ return -1;
+}
+
+void flip2_setup(PROGRAMMER * pgm)
+{
+}
+
+void flip2_teardown(PROGRAMMER * pgm)
+{
+}
+
+
+#endif /* HAVE_LIBUSB */

View File

@ -1,12 +0,0 @@
diff --git a/tests/data/test172 b/tests/data/test172
index b3efae9..3d53418 100644
--- a/tests/data/test172
+++ b/tests/data/test172
@@ -36,7 +36,7 @@ http://%HOSTIP:%HTTPPORT/we/want/172 -b log/jar172.txt -b "tool=curl; name=fool"
.%HOSTIP TRUE /silly/ FALSE 0 ismatch this
.%HOSTIP TRUE / FALSE 0 partmatch present
-%HOSTIP FALSE /we/want/ FALSE 1391252187 nodomain value
+%HOSTIP FALSE /we/want/ FALSE 2139150993 nodomain value
</file>
</client>

View File

@ -0,0 +1,70 @@
Update to libftdi-1.0 is advertised as a drop-in replacement for libftdi,
running on top of libusb-1.0. This also removes indirect dependency to
libusb-0.1.
Patch by Kyösti Mälkki <kyosti.malkki@gmail.com>.
See <http://patchwork.coreboot.org/patch/3904/>.
--- flashrom/Makefile.orig 2013-08-13 18:00:00.000000000 -0400
+++ flashrom/Makefile 2014-08-05 03:10:40.217145375 -0400
@@ -492,19 +492,21 @@
ifeq ($(CONFIG_FT2232_SPI), yes)
# This is a totally ugly hack.
FEATURE_CFLAGS += $(shell LC_ALL=C grep -q "FTDISUPPORT := yes" .features && printf "%s" "-D'CONFIG_FT2232_SPI=1'")
-NEED_FTDI := yes
+NEED_FTDI1 := yes
PROGRAMMER_OBJS += ft2232_spi.o
endif
ifeq ($(CONFIG_USBBLASTER_SPI), yes)
# This is a totally ugly hack.
FEATURE_CFLAGS += $(shell LC_ALL=C grep -q "FTDISUPPORT := yes" .features && printf "%s" "-D'CONFIG_USBBLASTER_SPI=1'")
-NEED_FTDI := yes
+NEED_LIBUSB1 := yes
+NEED_FTDI1 := yes
PROGRAMMER_OBJS += usbblaster_spi.o
endif
-ifeq ($(NEED_FTDI), yes)
-FTDILIBS := $(shell pkg-config --libs libftdi 2>/dev/null || printf "%s" "-lftdi -lusb")
+ifeq ($(NEED_FTDI1), yes)
+FTDILIBS := $(shell pkg-config --libs libftdi1 2>/dev/null || printf "%s" "-lftdi1 -lusb-1.0")
+FEATURE_CFLAGS += $(shell pkg-config --cflags libftdi1 2>/dev/null)
FEATURE_CFLAGS += $(shell LC_ALL=C grep -q "FT232H := yes" .features && printf "%s" "-D'HAVE_FT232H=1'")
FEATURE_LIBS += $(shell LC_ALL=C grep -q "FTDISUPPORT := yes" .features && printf "%s" "$(FTDILIBS)")
# We can't set NEED_USB here because that would transform libftdi auto-enabling
@@ -781,6 +783,7 @@
endif
define FTDI_TEST
+#include <stddef.h>
#include <ftdi.h>
struct ftdi_context *ftdic = NULL;
int main(int argc, char **argv)
@@ -793,6 +796,7 @@
export FTDI_TEST
define FTDI_232H_TEST
+#include <stddef.h>
#include <ftdi.h>
enum ftdi_chip_type type = TYPE_232H;
endef
@@ -826,15 +830,15 @@
features: compiler
@echo "FEATURES := yes" > .features.tmp
-ifeq ($(NEED_FTDI), yes)
+ifeq ($(NEED_FTDI1), yes)
@printf "Checking for FTDI support... "
@echo "$$FTDI_TEST" > .featuretest.c
- @$(CC) $(CPPFLAGS) $(CFLAGS) $(LDFLAGS) .featuretest.c -o .featuretest$(EXEC_SUFFIX) $(FTDILIBS) $(LIBS) >/dev/null 2>&1 && \
+ @$(CC) $(CPPFLAGS) $(CFLAGS) $(FEATURE_CFLAGS) $(LDFLAGS) .featuretest.c -o .featuretest$(EXEC_SUFFIX) $(FTDILIBS) $(LIBS) >/dev/null 2>&1 && \
( echo "found."; echo "FTDISUPPORT := yes" >> .features.tmp ) || \
( echo "not found."; echo "FTDISUPPORT := no" >> .features.tmp )
@printf "Checking for FT232H support in libftdi... "
@echo "$$FTDI_232H_TEST" >> .featuretest.c
- @$(CC) $(CPPFLAGS) $(CFLAGS) $(LDFLAGS) .featuretest.c -o .featuretest$(EXEC_SUFFIX) $(FTDILIBS) $(LIBS) >/dev/null 2>&1 && \
+ @$(CC) $(CPPFLAGS) $(CFLAGS) $(FEATURE_CFLAGS) $(LDFLAGS) .featuretest.c -o .featuretest$(EXEC_SUFFIX) $(FTDILIBS) $(LIBS) >/dev/null 2>&1 && \
( echo "found."; echo "FT232H := yes" >> .features.tmp ) || \
( echo "not found."; echo "FT232H := no" >> .features.tmp )
endif

View File

@ -0,0 +1,85 @@
fancontrol: Deal with moving hwmon attributes
Several kernel drivers have already moved their attributes from the
hardware device to the hwmon class device, and others will follow.
Teach fancontrol about this possibility and let it adjust the attribute
paths transparently.
Patch by Jean Delvare <khali@linux-fr.org>.
See <http://www.lm-sensors.org/changeset/6216>.
--- lm-sensors/prog/pwm/fancontrol (revision 6172)
+++ lm-sensors/prog/pwm/fancontrol (revision 6216)
@@ -207,4 +207,63 @@
}
+function FixupDeviceFiles
+{
+ local DEVICE="$1"
+ local fcvcount pwmo tsen fan
+
+ let fcvcount=0
+ while (( $fcvcount < ${#AFCPWM[@]} )) # go through all pwm outputs
+ do
+ pwmo=${AFCPWM[$fcvcount]}
+ AFCPWM[$fcvcount]=${pwmo//$DEVICE\/device/$DEVICE}
+ if [ "${AFCPWM[$fcvcount]}" != "$pwmo" ]
+ then
+ echo "Adjusing $pwmo -> ${AFCPWM[$fcvcount]}"
+ fi
+ let fcvcount=$fcvcount+1
+ done
+
+ let fcvcount=0
+ while (( $fcvcount < ${#AFCTEMP[@]} )) # go through all temp inputs
+ do
+ tsen=${AFCTEMP[$fcvcount]}
+ AFCTEMP[$fcvcount]=${tsen//$DEVICE\/device/$DEVICE}
+ if [ "${AFCTEMP[$fcvcount]}" != "$tsen" ]
+ then
+ echo "Adjusing $tsen -> ${AFCTEMP[$fcvcount]}"
+ fi
+ let fcvcount=$fcvcount+1
+ done
+
+ let fcvcount=0
+ while (( $fcvcount < ${#AFCFAN[@]} )) # go through all fan inputs
+ do
+ fan=${AFCFAN[$fcvcount]}
+ AFCFAN[$fcvcount]=${fan//$DEVICE\/device/$DEVICE}
+ if [ "${AFCFAN[$fcvcount]}" != "$fan" ]
+ then
+ echo "Adjusing $fan -> ${AFCFAN[$fcvcount]}"
+ fi
+ let fcvcount=$fcvcount+1
+ done
+}
+
+# Some drivers moved their attributes from hard device to class device
+function FixupFiles
+{
+ local DEVPATH="$1"
+ local entry device
+
+ for entry in $DEVPATH
+ do
+ device=`echo "$entry" | sed -e 's/=[^=]*$//'`
+
+ if [ -e "$device/name" ]
+ then
+ FixupDeviceFiles "$device"
+ fi
+ done
+}
+
# Check that all referenced sysfs files exist
function CheckFiles
@@ -306,4 +365,8 @@
echo "Configuration appears to be outdated, please run pwmconfig again" >&2
exit 1
+fi
+if [ "$DIR" = "/sys/class/hwmon" ]
+then
+ FixupFiles "$DEVPATH"
fi
CheckFiles || exit 1

View File

@ -0,0 +1,51 @@
The 'intcompare' definition was causing a "cast from 'void*' to 'int' loses
precision [-fpermissive]" error. It isn't used anywhere, so simply remove it.
Same with 'findint' in texteditor.cc.
Fix other "cast from void* to int loses precision" errors.
--- a/kkstrtext-0.1/kkstrtext.cc 2005-01-31 18:13:24.000000000 -0600
+++ b/kkstrtext-0.1/kkstrtext.cc 2014-07-24 00:25:07.149305476 -0500
@@ -430,10 +430,6 @@
}
}
-int intcompare(void *s1, void *s2) {
- return (int) s1 != (int) s2;
-}
-
string i2str(int i) {
char buf[64];
sprintf(buf, "%d", i);
@@ -885,7 +881,7 @@
#ifdef HAVE_ICONV
iconv_t cd = iconv_open(tocs.c_str(), fromcs.c_str());
- if(((int) cd) != -1) {
+ if(cd != (iconv_t) -1) {
string r, text(atext);
size_t inleft, outleft, soutleft;
char *inbuf, *outbuf, *sinbuf, *soutbuf;
--- a/kkconsui-0.1/src/texteditor.cc 2003-09-09 16:51:33.000000000 -0500
+++ b/kkconsui-0.1/src/texteditor.cc 2014-07-24 00:33:20.093279060 -0500
@@ -1939,10 +1939,6 @@
if(ur) delete ur;
}
-int texteditor::findint(void *p1, void *p2) {
- return *(int *) p1 != (int) p2;
-}
-
int texteditor::findhighline(void *p1, void *p2) {
return *(int *) p1 != ((highline *) p2)->line;
}
--- a/src/streamtrack.cc 2006-05-11 12:45:20.000000000 -0500
+++ b/src/streamtrack.cc 2014-07-24 00:38:10.797263482 -0500
@@ -34,6 +34,7 @@
#include <sys/wait.h>
#include <sys/stat.h>
#include <signal.h>
+#include <unistd.h>
#include <algorithm>

View File

@ -0,0 +1,31 @@
Patch derived from discussion at https://savannah.nongnu.org/bugs/?37503
--- texi2html-5.0/texi2html.pl 2010-06-30 17:01:27.000000000 -0500
+++ texi2html-5.0/texi2html.pl 2014-07-09 01:17:57.062990582 -0500
@@ -2589,7 +2589,12 @@
my $state = shift;
# FIXME this should be done only once, for @documentencoding
- my $encoding = lc(Texi2HTML::Config::get_conf('DOCUMENT_ENCODING'));
+ my $encoding;
+ my $input_encoding = Texi2HTML::Config::get_conf('documentencoding');
+ if (defined($input_encoding))
+ {
+ $encoding = lc($input_encoding);
+ }
if (defined($encoding) and $encoding ne '' and exists($Texi2HTML::Config::t2h_encoding_aliases{$encoding}))
{
$encoding = $Texi2HTML::Config::t2h_encoding_aliases{$encoding};
Fix failures in test/encodings.
--- texi2html-5.0/texi2html.pl 2014-07-09 01:22:06.000000000 -0500
+++ texi2html-5.0/texi2html.pl 2014-07-10 23:23:47.182097602 -0500
@@ -53,6 +53,7 @@
# for translations
#use encoding 'utf8';
#use utf8;
+binmode STDERR, ':encoding(utf8)';
#
# According to

View File

@ -0,0 +1,50 @@
Do not try to regenerate po files; use the reference files that are packaged
in the tarball.
--- a/Makefile.in 2010-06-30 17:02:28.000000000 -0500
+++ b/Makefile.in 2014-08-16 00:22:38.447050269 -0500
@@ -1022,15 +1022,7 @@
i18n/en.thl i18n/: $(po_document_dir)/po_document/$(PACKAGE)_document.pot
$(MKDIR_P) i18n
- if test '$(USE_NLS)' = 'yes'; then \
- for file in "$(srcdir)/$(po_document_dir)/po_document/"*".po"; do lang=`basename "$$file" .po | sed 's/\..*//'`; \
- test "$$lang" = 'en' && continue; \
- msgexec -i "$$file" "$(srcdir)/gettext_to_separated.pl" | "$(srcdir)/separated_to_hash.pl" $$lang > i18n/$$lang.thl; \
- done; \
- msgexec -i $< "$(srcdir)/gettext_to_separated.pl" | "$(srcdir)/separated_to_hash.pl" en > i18n/en.thl; \
- else \
- cp -p i18n_ref/*.thl i18n; \
- fi
+ cp -p i18n_ref/*.thl i18n
i18n_ref:
$(MKDIR_P) i18n_ref
Have install-sh install .mo files locally for in-source tests, so that msgfmt
is not needed.
--- a/Makefile.in 2010-06-30 17:02:28.000000000 -0500
+++ b/Makefile.in 2014-08-16 00:22:38.447050269 -0500
@@ -1052,19 +1044,8 @@
# update the po files, and install locally the .mo files for the in
# source tests
check-local: makeinfo.pl texi2any.pl
- if test '$(USE_NLS)' = 'yes'; then \
- cd $(po_document_dir)/po_document && $(MAKE) $(AM_MAKEFLAGS) update-po; \
- fi
- rm -rf locales
- for file in "$(srcdir)/$(po_document_dir)/po_document/"*.po; do \
- basename=`basename "$$file" .po` ; \
- $(MKDIR_P) "locales/$$basename/LC_MESSAGES/" ; \
- if test '$(USE_NLS)' = 'yes'; then \
- $(MSGFMT) "$$file" -o "locales/$$basename/LC_MESSAGES/texi2html_document.mo" ; \
- else \
- cp -p "$(srcdir)/$(po_document_dir)/po_document/$$basename.mo" "locales/$$basename/LC_MESSAGES/texi2html_document.mo" ; \
- fi; \
- done
+ $(MAKE) -C po_document localedir="$(abs_srcdir)/locales" install-data
+ $(MAKE) -C po_messages localedir="$(abs_srcdir)/locales" install-data
makeinfo.pl texi2any.pl:
-$(LN_S) $(srcdir)/texi2html.pl $@

75
gnu/packages/rrdtool.scm Normal file
View File

@ -0,0 +1,75 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages rrdtool)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (gnu packages)
#:use-module (gnu packages base)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages groff)
#:use-module (gnu packages python)
#:use-module (gnu packages fontutils)
#:use-module (gnu packages glib)
#:use-module (gnu packages gtk)
#:use-module (gnu packages xml))
(define-public rrdtool
(package
(name "rrdtool")
(version "1.4.8")
(source (origin
(method url-fetch)
(uri (string-append "http://oss.oetiker.ch/rrdtool/pub/rrdtool-"
version ".tar.gz"))
(sha256
(base32
"1mpki7pv5ql73h5al04dps6dky0nqc3mmb8ac21hd2s8mbsvk5fy"))))
(build-system gnu-build-system)
(inputs `(("cairo" ,cairo)
("glib" ,glib)
("gtk" ,gtk+-2)
("pango" ,pango)
("freetype" ,freetype)
("libxml2" ,libxml2)
("python" ,python-2)))
(native-inputs `(("pkg-config" ,pkg-config)
("groff" ,groff)))
(arguments
'(#:phases (alist-cons-before
'configure 'pre-configure
(lambda _
(substitute* "libtool"
(("/bin/sed") (which "sed")))
(substitute* "src/Makefile.in"
(("^rrdcached_LDADD = librrd_th.la")
"rrdcached_LDADD = librrd_th.la -lglib-2.0")))
%standard-phases)))
(home-page "http://oss.oetiker.ch/rrdtool/")
(synopsis "Time-series data storage and display system")
(description
"The Round Robin Database Tool (RRDtool) is a system to store and display
time-series data (e.g. network bandwidth, machine-room temperature, server
load average). It stores the data in Round Robin Databases (RRDs), a very
compact way that will not expand over time. RRDtool processes the extracted
data to enforce a certain data density, allowing for useful graphical
representation of data values.")
(license license:gpl2+))) ; with license exception that allows combining
; with many other licenses.

View File

@ -29,13 +29,13 @@
(define-public xapian (define-public xapian
(package (package
(name "xapian") (name "xapian")
(version "1.2.17") (version "1.2.18")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "http://oligarchy.co.uk/xapian/" version (uri (string-append "http://oligarchy.co.uk/xapian/" version
"/xapian-core-" version ".tar.xz")) "/xapian-core-" version ".tar.xz"))
(sha256 (sha256
(base32 "1pn65h06c23imck2pb42zhrrngch3clk39wl2bjwyqhfyfq4b7g7")))) (base32 "16i063xzwxdrqy32vlr292lljb65hkg3xx0i2m0qx2v00pcn4b3n"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs `(("zlib" ,zlib) (inputs `(("zlib" ,zlib)
("util-linux" ,util-linux))) ("util-linux" ,util-linux)))

View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -21,6 +22,7 @@
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix download) #:use-module (guix download)
#:use-module (guix build-system gnu) #:use-module (guix build-system gnu)
#:use-module (gnu packages)
#:use-module (gnu packages compression) #:use-module (gnu packages compression)
#:use-module (gnu packages perl) #:use-module (gnu packages perl)
#:use-module (gnu packages ncurses)) #:use-module (gnu packages ncurses))
@ -64,3 +66,42 @@ is on expressing the content semantically, avoiding physical markup commands.")
(base32 (base32
"1rf9ckpqwixj65bw469i634897xwlgkm5i9g2hv3avl6mv7b0a3d")))) "1rf9ckpqwixj65bw469i634897xwlgkm5i9g2hv3avl6mv7b0a3d"))))
(inputs `(("ncurses" ,ncurses) ("xz" ,xz))))) (inputs `(("ncurses" ,ncurses) ("xz" ,xz)))))
(define-public texi2html
(package
(name "texi2html")
(version "5.0")
(source (origin
(method url-fetch)
(uri (string-append "mirror://savannah/" name "/" name "-"
version ".tar.bz2"))
(sha256
(base32
"1yprv64vrlcbksqv25asplnjg07mbq38lfclp1m5lj8cw878pag8"))
(patches
(list (search-patch "texi2html-document-encoding.patch")
(search-patch "texi2html-i18n.patch")))
(snippet
;; This file is modified by the patch above, but reset its
;; timestamp so we don't trigger the rule to update PO files,
;; which would require Gettext.
;; See <http://bugs.gnu.org/18247>.
'(utime "texi2html.pl" 0 0 0 0))))
(build-system gnu-build-system)
(inputs `(("perl" ,perl)))
(home-page "http://www.nongnu.org/texi2html/")
(synopsis "Convert Texinfo to HTML")
(description
"Texi2HTML is a Perl script which converts Texinfo source files to HTML
output. It now supports many advanced features, such as internationalization
and extremely configurable output formats.
Development of Texi2HTML moved to the GNU Texinfo repository in 2010, since it
was meant to replace the makeinfo implementation in GNU Texinfo. The route
forward for authors is, in most cases, to alter manuals and build processes as
necessary to use the new features of the makeinfo/texi2any implementation of
GNU Texinfo. The Texi2HTML maintainers (one of whom is the principal author
of the GNU Texinfo implementation) do not intend to make further releases of
Texi2HTML.")
;; Files in /lib under lgpl2.1+ and x11
(license gpl2+)))

View File

@ -32,14 +32,14 @@
(define-public tor (define-public tor
(package (package
(name "tor") (name "tor")
(version "0.2.4.22") (version "0.2.4.23")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://www.torproject.org/dist/tor-" (uri (string-append "https://www.torproject.org/dist/tor-"
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0k39ppcvld6p08yaf4rpspb34z4f5863j0d605yrm4dqjcp99xvb")))) "0a8l6d82hk4wbn7nlphd3c1maxhgdli8338wbg5r9dk6zcy7k8q5"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs (inputs
`(("zlib" ,zlib) `(("zlib" ,zlib)

View File

@ -294,14 +294,14 @@ property manipulation.")
(define-public subversion (define-public subversion
(package (package
(name "subversion") (name "subversion")
(version "1.7.14") (version "1.7.18")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "http://archive.apache.org/dist/subversion/subversion-" (uri (string-append "http://archive.apache.org/dist/subversion/subversion-"
version ".tar.bz2")) version ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"038jbcpwm083abp0rvk0fhnx65kp9mz1qvzs3f83ig8fxcvqzb64")))) "06nrqnn3qq1hhskkcdbm0ilk2xv6ay2gyf2c7qvxp6xncb782wzn"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
'(#:phases (alist-cons-after '(#:phases (alist-cons-after

View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2014 David Thompson <davet@gnu.org> ;;; Copyright © 2014 David Thompson <davet@gnu.org>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -18,6 +19,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages video) (define-module (gnu packages video)
#:use-module (ice-9 match)
#:use-module ((guix licenses) #:use-module ((guix licenses)
#:select (gpl2 gpl2+ bsd-3 public-domain)) #:select (gpl2 gpl2+ bsd-3 public-domain))
#:use-module (guix packages) #:use-module (guix packages)
@ -56,14 +58,14 @@
(define-public ffmpeg (define-public ffmpeg
(package (package
(name "ffmpeg") (name "ffmpeg")
(version "2.3") (version "2.3.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "http://www.ffmpeg.org/releases/ffmpeg-" (uri (string-append "http://www.ffmpeg.org/releases/ffmpeg-"
version ".tar.bz2")) version ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"17l0bx95al6cjhz3pzfcbwg07sbfbwqbxg34zl5lhl89w9jbngbb")))) "10w1sw5c9qjlaqlr77r3znzm7y0y9qpkni0mfr9rhij22562yspf"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs (inputs
`(("fontconfig" ,fontconfig) `(("fontconfig" ,fontconfig)
@ -168,31 +170,11 @@
"--enable-libtheora" "--enable-libtheora"
"--enable-libvorbis" "--enable-libvorbis"
"--enable-libvpx" "--enable-libvpx"
;; drop special machine instructions not supported
;; on all instances of the target "--enable-runtime-cpudetect"
,@(if (string-prefix? "x86_64"
(or (%current-target-system) ;; Runtime cpu detection is not implemented on
(%current-system))) ;; MIPS, so we disable some features.
'()
'("--disable-amd3dnow"
"--disable-amd3dnowext"
"--disable-mmx"
"--disable-mmxext"
"--disable-sse"
"--disable-sse2"))
"--disable-altivec"
"--disable-sse3"
"--disable-ssse3"
"--disable-sse4"
"--disable-sse42"
"--disable-avx"
"--disable-fma4"
"--disable-avx2"
"--disable-armv5te"
"--disable-armv6"
"--disable-armv6t2"
"--disable-vfp"
"--disable-neon"
"--disable-mips32r2" "--disable-mips32r2"
"--disable-mipsdspr1" "--disable-mipsdspr1"
"--disable-mipsdspr2" "--disable-mipsdspr2"
@ -268,10 +250,6 @@ audio/video codec library.")
(arguments (arguments
`(#:configure-flags `(#:configure-flags
`("--disable-a52" ; FIXME: reenable once available `("--disable-a52" ; FIXME: reenable once available
"--disable-mmx" ; FIXME: may be enabled on x86_64
"--disable-sse" ; 1-4, no separate options available
"--disable-neon"
"--disable-altivec"
,(string-append "LDFLAGS=-Wl,-rpath -Wl," ,(string-append "LDFLAGS=-Wl,-rpath -Wl,"
(assoc-ref %build-inputs "ffmpeg") (assoc-ref %build-inputs "ffmpeg")
"/lib")))) ; needed for the tests "/lib")))) ; needed for the tests
@ -342,20 +320,18 @@ treaming protocols.")
libx11 "/include") ; to detect libx11 libx11 "/include") ; to detect libx11
"--disable-tremor-internal" ; forces external libvorbis "--disable-tremor-internal" ; forces external libvorbis
(string-append "--prefix=" out) (string-append "--prefix=" out)
;; drop special machine instructions not supported ;; Enable runtime cpu detection where supported,
;; on all instances of the target ;; and choose a suitable target.
,@(if (string-prefix? "x86_64" ,@(match (or (%current-target-system)
(or (%current-target-system) (%current-system))
(%current-system))) ("x86_64-linux"
'() '("--enable-runtime-cpudetection"
'("--disable-3dnow" "--target=x86_64-linux"))
"--disable-3dnowext" ("i686-linux"
"--disable-mmx" '("--enable-runtime-cpudetection"
"--disable-mmxext" "--target=i686-linux"))
"--disable-sse" ("mips64el-linux"
"--disable-sse2")) '("--target=mips3-linux")))
"--disable-ssse3"
"--disable-altivec"
"--disable-armv5te" "--disable-armv5te"
"--disable-armv6" "--disable-armv6"
"--disable-armv6t2" "--disable-armv6t2"

View File

@ -331,6 +331,29 @@ tracking.")
(license license:x11))) (license license:x11)))
;; not part of X11R7.7, required for newer versions of mesa
(define-public dri3proto
(package
(name "dri3proto")
(version "1.0")
(source
(origin
(method url-fetch)
(uri (string-append
"mirror://xorg/individual/proto/dri3proto-"
version
".tar.bz2"))
(sha256
(base32
"0x609xvnl8jky5m8jdklw4nymx3irkv32w99dfd8nl800bblkgh1"))))
(build-system gnu-build-system)
(home-page "http://www.x.org/wiki/")
(synopsis "xorg implementation of the X Window System")
(description "X.org provides an implementation of the X Window System")
(license (license:x11-style "file://dri3proto.h"
"See 'dri3proto.h' in the distribution."))))
(define-public encodings (define-public encodings
(package (package
(name "encodings") (name "encodings")
@ -1521,6 +1544,28 @@ tracking.")
(license license:x11))) (license license:x11)))
;; not part of X11R7.7, required for newer versions of mesa
(define-public presentproto
(package
(name "presentproto")
(version "1.0")
(source
(origin
(method url-fetch)
(uri (string-append
"mirror://xorg/individual/proto/presentproto-"
version
".tar.bz2"))
(sha256
(base32
"1kir51aqg9cwazs14ivcldcn3mzadqgykc9cg87rm40zf947sb41"))))
(build-system gnu-build-system)
(home-page "http://www.x.org/wiki/")
(synopsis "xorg implementation of the X Window System")
(description "X.org provides an implementation of the X Window System")
(license (license:x11-style "file://presentproto.h"
"See 'presentproto.h' in the distribution."))))
;; The package is missing from X11R7.7. ;; The package is missing from X11R7.7.
(define-public printproto (define-public printproto
(package (package
@ -1696,9 +1741,15 @@ tracking.")
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs (inputs
`(("libxkbfile" ,libxkbfile) `(("libxkbfile" ,libxkbfile)
("xkeyboard-config" ,xkeyboard-config)
("libx11" ,libx11))) ("libx11" ,libx11)))
(native-inputs (native-inputs
`(("pkg-config" ,pkg-config))) `(("pkg-config" ,pkg-config)))
(arguments
`(#:configure-flags
(list (string-append "--with-xkb-config-root="
(assoc-ref %build-inputs "xkeyboard-config")
"/share/X11/xkb"))))
(home-page "http://www.x.org/wiki/") (home-page "http://www.x.org/wiki/")
(synopsis "xorg implementation of the X Window System") (synopsis "xorg implementation of the X Window System")
(description "X.org provides an implementation of the X Window System") (description "X.org provides an implementation of the X Window System")
@ -2170,9 +2221,15 @@ tracking.")
(base32 (base32
"1ivf5n821chckrgp89mpb18zi00v1hyrkc1hr82q0x6g1kpgxq9y")))) "1ivf5n821chckrgp89mpb18zi00v1hyrkc1hr82q0x6g1kpgxq9y"))))
(build-system gnu-build-system) (build-system gnu-build-system)
;; FIXME: Add required input udev once it is available. (inputs
(inputs `(("xorg-server" ,xorg-server))) `(("udev" ,udev)
("xorg-server" ,xorg-server)))
(native-inputs `(("pkg-config" ,pkg-config))) (native-inputs `(("pkg-config" ,pkg-config)))
(arguments
`(#:configure-flags
(list (string-append "--with-sdkdir="
(assoc-ref %outputs "out")
"/include/xorg"))))
(home-page "http://www.x.org/wiki/") (home-page "http://www.x.org/wiki/")
(synopsis "xorg implementation of the X Window System") (synopsis "xorg implementation of the X Window System")
(description "X.org provides an implementation of the X Window System") (description "X.org provides an implementation of the X Window System")

View File

@ -132,6 +132,7 @@ The other options should be self-descriptive."
"lshd" "lshd"
#:allow-empty-passwords? allow-empty-passwords?))) #:allow-empty-passwords? allow-empty-passwords?)))
(activate #~(begin (activate #~(begin
(use-modules (guix build utils))
(mkdir-p "/var/spool/lsh") (mkdir-p "/var/spool/lsh")
#$(if initialize? #$(if initialize?
(activation lsh host-key) (activation lsh host-key)

View File

@ -23,6 +23,7 @@
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix profiles)
#:use-module (gnu packages base) #:use-module (gnu packages base)
#:use-module (gnu packages bash) #:use-module (gnu packages bash)
#:use-module (gnu packages which) #:use-module (gnu packages which)
@ -125,29 +126,6 @@
;;; Derivation. ;;; Derivation.
;;; ;;;
(define* (union inputs
#:key (guile (%guile-for-build))
(name "union"))
"Return a derivation that builds the union of INPUTS. INPUTS is a list of
input tuples."
(define builder
#~(begin
(use-modules (guix build union))
(define inputs '#$inputs)
(setvbuf (current-output-port) _IOLBF)
(setvbuf (current-error-port) _IOLBF)
(format #t "building union `~a' with ~a packages...~%"
#$output (length inputs))
(union-build #$output inputs)))
(gexp->derivation name builder
#:modules '((guix build union))
#:guile-for-build guile
#:local-build? #t))
(define* (file-union name files) (define* (file-union name files)
"Return a derivation that builds a directory containing all of FILES. Each "Return a derivation that builds a directory containing all of FILES. Each
item in FILES must be a list where the first element is the file name to use item in FILES must be a list where the first element is the file name to use
@ -294,10 +272,9 @@ alias ll='ls -l'
("sudoers" ,#~#$sudoers))))) ("sudoers" ,#~#$sudoers)))))
(define (operating-system-profile os) (define (operating-system-profile os)
"Return a derivation that builds the default profile of OS." "Return a derivation that builds the system profile of OS."
;; TODO: Replace with a real profile with a manifest. (profile-derivation (manifest (map package->manifest-entry
(union (operating-system-packages os) (operating-system-packages os)))))
#:name "default-profile"))
(define %root-account (define %root-account
;; Default root account. ;; Default root account.

View File

@ -49,7 +49,7 @@
(menu-entries grub-configuration-menu-entries ; list (menu-entries grub-configuration-menu-entries ; list
(default '())) (default '()))
(default-entry grub-configuration-default-entry ; integer (default-entry grub-configuration-default-entry ; integer
(default 1)) (default 0))
(timeout grub-configuration-timeout ; integer (timeout grub-configuration-timeout ; integer
(default 5))) (default 5)))

View File

@ -241,7 +241,7 @@ exception and backtrace!)."
(define virtio-9p-modules (define virtio-9p-modules
;; Modules for the 9p paravirtualized file system. ;; Modules for the 9p paravirtualized file system.
'("9pnet.ko" "9p.ko" "9pnet_virtio.ko")) '("fscache.ko" "9pnet.ko" "9p.ko" "9pnet_virtio.ko"))
(define (file-system-type-predicate type) (define (file-system-type-predicate type)
(lambda (fs) (lambda (fs)

View File

@ -30,6 +30,7 @@
ftp-client ftp-client
gexp gexp
monads monads
monad-repl
packages packages
store store
utils)) utils))

View File

@ -0,0 +1,92 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix build emacs-utils)
#:export (%emacs
emacs-batch-eval
emacs-batch-edit-file
emacs-substitute-sexps
emacs-substitute-variables))
;;; Commentary:
;;;
;;; Tools to programmatically edit files using Emacs,
;;; e.g. to replace entire s-expressions in elisp files.
;;;
;;; Code:
(define %emacs
;; The `emacs' command.
(make-parameter "emacs"))
(define (emacs-batch-eval expr)
"Run Emacs in batch mode, and execute the elisp code EXPR."
(unless (zero? (system* (%emacs) "--quick" "--batch"
(format #f "--eval=~S" expr)))
(error "emacs-batch-eval failed!" expr)))
(define (emacs-batch-edit-file file expr)
"Load FILE in Emacs using batch mode, and execute the elisp code EXPR."
(unless (zero? (system* (%emacs) "--quick" "--batch"
(string-append "--visit=" file)
(format #f "--eval=~S" expr)))
(error "emacs-batch-edit-file failed!" file expr)))
(define-syntax emacs-substitute-sexps
(syntax-rules ()
"Substitute the S-expression immediately following the first occurrence of
LEADING-REGEXP by the string returned by REPLACEMENT in FILE. For example:
(emacs-substitute-sexps \"w3m.el\"
(\"defcustom w3m-command\"
(string-append w3m \"/bin/w3m\"))
(\"defvar w3m-image-viewer\"
(string-append imagemagick \"/bin/display\")))
This replaces the default values of the `w3m-command' and `w3m-image-viewer'
variables declared in `w3m.el' with the results of the `string-append' calls
above. Note that LEADING-REGEXP uses Emacs regexp syntax."
((emacs-substitute-sexps file (leading-regexp replacement) ...)
(emacs-batch-edit-file file
`(progn (progn (goto-char (point-min))
(re-search-forward ,leading-regexp)
(kill-sexp)
(insert " ")
(insert ,(format #f "~S" replacement)))
...
(basic-save-buffer))))))
(define-syntax emacs-substitute-variables
(syntax-rules ()
"Substitute the default value of VARIABLE by the string returned by
REPLACEMENT in FILE. For example:
(emacs-substitute-variables \"w3m.el\"
(\"w3m-command\" (string-append w3m \"/bin/w3m\"))
(\"w3m-image-viewer\" (string-append imagemagick \"/bin/display\")))
This replaces the default values of the `w3m-command' and `w3m-image-viewer'
variables declared in `w3m.el' with the results of the `string-append' calls
above."
((emacs-substitute-variables file (variable replacement) ...)
(emacs-substitute-sexps file
((string-append "(def[a-z]+[[:space:]\n]+" variable "\\>")
replacement)
...))))
;;; emacs-utils.scm ends here

View File

@ -384,11 +384,9 @@ networking values.) Return #t if INTERFACE is up, #f otherwise."
(set-network-interface-address sock interface address) (set-network-interface-address sock interface address)
(set-network-interface-flags sock interface (logior flags IFF_UP)) (set-network-interface-flags sock interface (logior flags IFF_UP))
(unless (file-exists? "/etc") ;; Hello! We used to create /etc/resolv.conf here, with "nameserver
(mkdir "/etc")) ;; 10.0.2.3\n". However, with Linux-libre 3.16, we're getting ENOSPC.
(call-with-output-file "/etc/resolv.conf" ;; And since it's actually unnecessary, it's gone.
(lambda (p)
(display "nameserver 10.0.2.3\n" p)))
(logand (network-interface-flags sock interface) IFF_UP))) (logand (network-interface-flags sock interface) IFF_UP)))

View File

@ -130,7 +130,6 @@
"ftp://ftp.piotrkosoft.net/pub/mirrors/ftp.x.org/" "ftp://ftp.piotrkosoft.net/pub/mirrors/ftp.x.org/"
"ftp://ftp.portal-to-web.de/pub/mirrors/x.org/" "ftp://ftp.portal-to-web.de/pub/mirrors/x.org/"
"ftp://ftp.solnet.ch/mirror/x.org/" "ftp://ftp.solnet.ch/mirror/x.org/"
"ftp://ftp.sunet.se/pub/X11/"
"ftp://gd.tuwien.ac.at/X11/" "ftp://gd.tuwien.ac.at/X11/"
"ftp://mi.mirror.garr.it/mirrors/x.org/" "ftp://mi.mirror.garr.it/mirrors/x.org/"
"ftp://mirror.cict.fr/x.org/" "ftp://mirror.cict.fr/x.org/"
@ -161,7 +160,6 @@
;; from http://www.imagemagick.org/script/download.php ;; from http://www.imagemagick.org/script/download.php
;; (without mirrors that are unavailable or not up to date) ;; (without mirrors that are unavailable or not up to date)
;; mirrors keeping old versions at the top level ;; mirrors keeping old versions at the top level
"ftp://ftp.sunet.se/pub/multimedia/graphics/ImageMagick/"
"ftp://sunsite.icm.edu.pl/packages/ImageMagick/" "ftp://sunsite.icm.edu.pl/packages/ImageMagick/"
;; mirrors moving old versions to "legacy" ;; mirrors moving old versions to "legacy"
"http://mirrors-au.go-parts.com/mirrors/ImageMagick/" "http://mirrors-au.go-parts.com/mirrors/ImageMagick/"

View File

@ -41,7 +41,9 @@
;;; S-expressions (sexps), with two differences: ;;; S-expressions (sexps), with two differences:
;;; ;;;
;;; 1. References (un-quotations) to derivations or packages in a gexp are ;;; 1. References (un-quotations) to derivations or packages in a gexp are
;;; replaced by the corresponding output file name; ;;; replaced by the corresponding output file name; in addition, the
;;; 'ungexp-native' unquote-like form allows code to explicitly refer to
;;; the native code of a given package, in case of cross-compilation;
;;; ;;;
;;; 2. Gexps embed information about the derivations they refer to. ;;; 2. Gexps embed information about the derivations they refer to.
;;; ;;;
@ -52,9 +54,10 @@
;; "G expressions". ;; "G expressions".
(define-record-type <gexp> (define-record-type <gexp>
(make-gexp references proc) (make-gexp references natives proc)
gexp? gexp?
(references gexp-references) ; ((DRV-OR-PKG OUTPUT) ...) (references gexp-references) ; ((DRV-OR-PKG OUTPUT) ...)
(natives gexp-native-references) ; ((DRV-OR-PKG OUTPUT) ...)
(proc gexp-proc)) ; procedure (proc gexp-proc)) ; procedure
(define (write-gexp gexp port) (define (write-gexp gexp port)
@ -65,7 +68,10 @@
;; doing things like (ungexp-splicing (gexp ())) because GEXP's procedure ;; doing things like (ungexp-splicing (gexp ())) because GEXP's procedure
;; tries to use 'append' on that, which fails with wrong-type-arg. ;; tries to use 'append' on that, which fails with wrong-type-arg.
(false-if-exception (false-if-exception
(write (apply (gexp-proc gexp) (gexp-references gexp)) port)) (write (apply (gexp-proc gexp)
(append (gexp-references gexp)
(gexp-native-references gexp)))
port))
(format port " ~a>" (format port " ~a>"
(number->string (object-address gexp) 16))) (number->string (object-address gexp) 16)))
@ -81,14 +87,20 @@
(define raw-derivation (define raw-derivation
(store-lift derivation)) (store-lift derivation))
(define (lower-inputs inputs) (define* (lower-inputs inputs
"Turn any package from INPUTS into a derivation; return the corresponding #:key system target)
input list as a monadic value." "Turn any package from INPUTS into a derivation for SYSTEM; return the
corresponding input list as a monadic value. When TARGET is true, use it as
the cross-compilation target triplet."
(with-monad %store-monad (with-monad %store-monad
(sequence %store-monad (sequence %store-monad
(map (match-lambda (map (match-lambda
(((? package? package) sub-drv ...) (((? package? package) sub-drv ...)
(mlet %store-monad ((drv (package->derivation package))) (mlet %store-monad
((drv (if target
(package->cross-derivation package target
system)
(package->derivation package system))))
(return `(,drv ,@sub-drv)))) (return `(,drv ,@sub-drv))))
(((? origin? origin) sub-drv ...) (((? origin? origin) sub-drv ...)
(mlet %store-monad ((drv (origin->derivation origin))) (mlet %store-monad ((drv (origin->derivation origin)))
@ -99,7 +111,7 @@ input list as a monadic value."
(define* (gexp->derivation name exp (define* (gexp->derivation name exp
#:key #:key
system system (target 'current)
hash hash-algo recursive? hash hash-algo recursive?
(env-vars '()) (env-vars '())
(modules '()) (modules '())
@ -107,7 +119,8 @@ input list as a monadic value."
references-graphs references-graphs
local-build?) local-build?)
"Return a derivation NAME that runs EXP (a gexp) with GUILE-FOR-BUILD (a "Return a derivation NAME that runs EXP (a gexp) with GUILE-FOR-BUILD (a
derivation) on SYSTEM. derivation) on SYSTEM. When TARGET is true, it is used as the
cross-compilation target triplet for packages referred to by EXP.
Make MODULES available in the evaluation context of EXP; MODULES is a list of Make MODULES available in the evaluation context of EXP; MODULES is a list of
names of Guile modules from the current search path to be copied in the store, names of Guile modules from the current search path to be copied in the store,
@ -118,9 +131,25 @@ The other arguments are as for 'derivation'."
(define %modules modules) (define %modules modules)
(define outputs (gexp-outputs exp)) (define outputs (gexp-outputs exp))
(mlet* %store-monad ((inputs (lower-inputs (gexp-inputs exp))) (mlet* %store-monad (;; The following binding is here to force
;; '%current-system' and '%current-target-system' to be
;; looked up at >>= time.
(unused (return #f))
(system -> (or system (%current-system))) (system -> (or system (%current-system)))
(sexp (gexp->sexp exp)) (target -> (if (eq? target 'current)
(%current-target-system)
target))
(normals (lower-inputs (gexp-inputs exp)
#:system system
#:target target))
(natives (lower-inputs (gexp-native-inputs exp)
#:system system
#:target #f))
(inputs -> (append normals natives))
(sexp (gexp->sexp exp
#:system system
#:target target))
(builder (text-file (string-append name "-builder") (builder (text-file (string-append name "-builder")
(object->string sexp))) (object->string sexp)))
(modules (if (pair? %modules) (modules (if (pair? %modules)
@ -158,8 +187,9 @@ The other arguments are as for 'derivation'."
#:references-graphs references-graphs #:references-graphs references-graphs
#:local-build? local-build?))) #:local-build? local-build?)))
(define (gexp-inputs exp) (define* (gexp-inputs exp #:optional (references gexp-references))
"Return the input list for EXP." "Return the input list for EXP, using REFERENCES to get its list of
references."
(define (add-reference-inputs ref result) (define (add-reference-inputs ref result)
(match ref (match ref
(((? derivation?) (? string?)) (((? derivation?) (? string?))
@ -169,7 +199,7 @@ The other arguments are as for 'derivation'."
(((? origin?) (? string?)) (((? origin?) (? string?))
(cons ref result)) (cons ref result))
((? gexp? exp) ((? gexp? exp)
(append (gexp-inputs exp) result)) (append (gexp-inputs exp references) result))
(((? string? file)) (((? string? file))
(if (direct-store-path? file) (if (direct-store-path? file)
(cons ref result) (cons ref result)
@ -182,7 +212,10 @@ The other arguments are as for 'derivation'."
(fold-right add-reference-inputs (fold-right add-reference-inputs
'() '()
(gexp-references exp))) (references exp)))
(define gexp-native-inputs
(cut gexp-inputs <> gexp-native-references))
(define (gexp-outputs exp) (define (gexp-outputs exp)
"Return the outputs referred to by EXP as a list of strings." "Return the outputs referred to by EXP as a list of strings."
@ -199,16 +232,21 @@ The other arguments are as for 'derivation'."
'() '()
(gexp-references exp))) (gexp-references exp)))
(define* (gexp->sexp exp) (define* (gexp->sexp exp #:key
(system (%current-system))
(target (%current-target-system)))
"Return (monadically) the sexp corresponding to EXP for the given OUTPUT, "Return (monadically) the sexp corresponding to EXP for the given OUTPUT,
and in the current monad setting (system type, etc.)" and in the current monad setting (system type, etc.)"
(define (reference->sexp ref) (define* (reference->sexp ref #:optional native?)
(with-monad %store-monad (with-monad %store-monad
(match ref (match ref
(((? derivation? drv) (? string? output)) (((? derivation? drv) (? string? output))
(return (derivation->output-path drv output))) (return (derivation->output-path drv output)))
(((? package? p) (? string? output)) (((? package? p) (? string? output))
(package-file p #:output output)) (package-file p
#:output output
#:system system
#:target (if native? #f target)))
(((? origin? o) (? string? output)) (((? origin? o) (? string? output))
(mlet %store-monad ((drv (origin->derivation o))) (mlet %store-monad ((drv (origin->derivation o)))
(return (derivation->output-path drv output)))) (return (derivation->output-path drv output))))
@ -218,17 +256,22 @@ and in the current monad setting (system type, etc.)"
;; that trick. ;; that trick.
(return `((@ (guile) getenv) ,output))) (return `((@ (guile) getenv) ,output)))
((? gexp? exp) ((? gexp? exp)
(gexp->sexp exp)) (gexp->sexp exp
#:system system
#:target (if native? #f target)))
(((? string? str)) (((? string? str))
(return (if (direct-store-path? str) str ref))) (return (if (direct-store-path? str) str ref)))
((refs ...) ((refs ...)
(sequence %store-monad (map reference->sexp refs))) (sequence %store-monad
(map (cut reference->sexp <> native?) refs)))
(x (x
(return x))))) (return x)))))
(mlet %store-monad (mlet %store-monad
((args (sequence %store-monad ((args (sequence %store-monad
(map reference->sexp (gexp-references exp))))) (append (map reference->sexp (gexp-references exp))
(map (cut reference->sexp <> #t)
(gexp-native-references exp))))))
(return (apply (gexp-proc exp) args)))) (return (apply (gexp-proc exp) args))))
(define (canonicalize-reference ref) (define (canonicalize-reference ref)
@ -285,9 +328,28 @@ package/derivation references."
(_ (_
result)))) result))))
(define (collect-native-escapes exp)
;; Return all the 'ungexp-native' forms present in EXP.
(let loop ((exp exp)
(result '()))
(syntax-case exp (ungexp-native ungexp-native-splicing)
((ungexp-native _)
(cons exp result))
((ungexp-native _ _)
(cons exp result))
((ungexp-native-splicing _ ...)
(cons exp result))
((exp0 exp ...)
(let ((result (loop #'exp0 result)))
(fold loop result #'(exp ...))))
(_
result))))
(define (escape->ref exp) (define (escape->ref exp)
;; Turn 'ungexp' form EXP into a "reference". ;; Turn 'ungexp' form EXP into a "reference".
(syntax-case exp (ungexp ungexp-splicing output) (syntax-case exp (ungexp ungexp-splicing
ungexp-native ungexp-native-splicing
output)
((ungexp output) ((ungexp output)
#'(output-ref "out")) #'(output-ref "out"))
((ungexp output name) ((ungexp output name)
@ -297,30 +359,49 @@ package/derivation references."
((ungexp drv-or-pkg out) ((ungexp drv-or-pkg out)
#'(list drv-or-pkg out)) #'(list drv-or-pkg out))
((ungexp-splicing lst) ((ungexp-splicing lst)
#'lst)
((ungexp-native thing)
#'thing)
((ungexp-native drv-or-pkg out)
#'(list drv-or-pkg out))
((ungexp-native-splicing lst)
#'lst))) #'lst)))
(define (substitute-ungexp exp substs)
;; Given EXP, an 'ungexp' or 'ungexp-native' form, substitute it with
;; the corresponding form in SUBSTS.
(match (assoc exp substs)
((_ id)
id)
(_
#'(syntax-error "error: no 'ungexp' substitution"
#'ref))))
(define (substitute-ungexp-splicing exp substs)
(syntax-case exp ()
((exp rest ...)
(match (assoc #'exp substs)
((_ id)
(with-syntax ((id id))
#`(append id
#,(substitute-references #'(rest ...) substs))))
(_
#'(syntax-error "error: no 'ungexp-splicing' substitution"
#'ref))))))
(define (substitute-references exp substs) (define (substitute-references exp substs)
;; Return a variant of EXP where all the cars of SUBSTS have been ;; Return a variant of EXP where all the cars of SUBSTS have been
;; replaced by the corresponding cdr. ;; replaced by the corresponding cdr.
(syntax-case exp (ungexp ungexp-splicing) (syntax-case exp (ungexp ungexp-native
ungexp-splicing ungexp-native-splicing)
((ungexp _ ...) ((ungexp _ ...)
(match (assoc exp substs) (substitute-ungexp exp substs))
((_ id) ((ungexp-native _ ...)
id) (substitute-ungexp exp substs))
(_
#'(syntax-error "error: no 'ungexp' substitution"
#'ref))))
(((ungexp-splicing _ ...) rest ...) (((ungexp-splicing _ ...) rest ...)
(syntax-case exp () (substitute-ungexp-splicing exp substs))
((exp rest ...) (((ungexp-native-splicing _ ...) rest ...)
(match (assoc #'exp substs) (substitute-ungexp-splicing exp substs))
((_ id)
(with-syntax ((id id))
#`(append id
#,(substitute-references #'(rest ...) substs))))
(_
#'(syntax-error "error: no 'ungexp-splicing' substitution"
#'ref))))))
((exp0 exp ...) ((exp0 exp ...)
#`(cons #,(substitute-references #'exp0 substs) #`(cons #,(substitute-references #'exp0 substs)
#,(substitute-references #'(exp ...) substs))) #,(substitute-references #'(exp ...) substs)))
@ -328,11 +409,15 @@ package/derivation references."
(syntax-case s (ungexp output) (syntax-case s (ungexp output)
((_ exp) ((_ exp)
(let* ((escapes (delete-duplicates (collect-escapes #'exp))) (let* ((normals (delete-duplicates (collect-escapes #'exp)))
(natives (delete-duplicates (collect-native-escapes #'exp)))
(escapes (append normals natives))
(formals (generate-temporaries escapes)) (formals (generate-temporaries escapes))
(sexp (substitute-references #'exp (zip escapes formals))) (sexp (substitute-references #'exp (zip escapes formals)))
(refs (map escape->ref escapes))) (refs (map escape->ref normals))
(nrefs (map escape->ref natives)))
#`(make-gexp (map canonicalize-reference (list #,@refs)) #`(make-gexp (map canonicalize-reference (list #,@refs))
(map canonicalize-reference (list #,@nrefs))
(lambda #,formals (lambda #,formals
#,sexp))))))) #,sexp)))))))
@ -385,22 +470,26 @@ its search path."
(write '(ungexp exp) port)))) (write '(ungexp exp) port))))
#:local-build? #t)) #:local-build? #t))
;;; ;;;
;;; Syntactic sugar. ;;; Syntactic sugar.
;;; ;;;
(eval-when (expand load eval) (eval-when (expand load eval)
(define (read-ungexp chr port) (define* (read-ungexp chr port #:optional native?)
"Read an 'ungexp' or 'ungexp-splicing' form from PORT." "Read an 'ungexp' or 'ungexp-splicing' form from PORT. When NATIVE? is
true, use 'ungexp-native' and 'ungexp-native-splicing' instead."
(define unquote-symbol (define unquote-symbol
(match (peek-char port) (match (peek-char port)
(#\@ (#\@
(read-char port) (read-char port)
'ungexp-splicing) (if native?
'ungexp-native-splicing
'ungexp-splicing))
(_ (_
'ungexp))) (if native?
'ungexp-native
'ungexp))))
(match (read port) (match (read port)
((? symbol? symbol) ((? symbol? symbol)
@ -421,6 +510,7 @@ its search path."
;; Extend the reader ;; Extend the reader
(read-hash-extend #\~ read-gexp) (read-hash-extend #\~ read-gexp)
(read-hash-extend #\$ read-ungexp)) (read-hash-extend #\$ read-ungexp)
(read-hash-extend #\+ (cut read-ungexp <> <> #t)))
;;; gexp.scm ends here ;;; gexp.scm ends here

81
guix/monad-repl.scm Normal file
View File

@ -0,0 +1,81 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix monad-repl)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (ice-9 pretty-print)
#:use-module (system repl repl)
#:use-module (system repl common)
#:use-module (system repl command)
#:use-module (system base language)
#:use-module (system base compile)
#:use-module (srfi srfi-26)
#:export (run-in-store
enter-store-monad))
;;; Comment:
;;;
;;; This modules provides a couple of REPL meta-commands that make it easier
;;; to work with monadic procedures in the store monad.
;;;
;;; Code:
(define* (monad-language monad run #:optional (name 'monad))
"Return a language with a special evaluator that causes monadic values
to be \"run\" in MONAD using procedure RUN."
(let ((scheme (lookup-language 'scheme)))
(define (evaluate-monadic-expression exp env)
(let ((mvalue (compile exp #:to 'value #:env env)))
(run mvalue)))
(make-language #:name name
#:title "Monad"
#:reader (language-reader scheme)
#:compilers (language-compilers scheme)
#:decompilers (language-decompilers scheme)
#:evaluator evaluate-monadic-expression
#:printer (language-printer scheme)
#:make-default-environment
(language-make-default-environment scheme))))
(define (store-monad-language)
"Return a compiler language for the store monad."
(let ((store (open-connection)))
(monad-language %store-monad
(cut run-with-store store <>)
'store-monad)))
(define-meta-command ((run-in-store guix) repl (form))
"run-in-store EXP
Run EXP through the store monad."
(let ((value (with-store store
(run-with-store store (repl-eval repl form)))))
(run-hook before-print-hook value)
(pretty-print value)))
(define-meta-command ((enter-store-monad guix) repl)
"enter-store-monad
Enter a REPL for values in the store monad."
(let ((new (make-repl (store-monad-language))))
;; Force interpretation so that our specially-crafted language evaluator
;; is actually used.
(repl-option-set! new 'interp #t)
(run-repl new)))
;;; monad-repl.scm ends here

View File

@ -59,6 +59,7 @@
package-file package-file
origin->derivation origin->derivation
package->derivation package->derivation
package->cross-derivation
built-derivations) built-derivations)
#:replace (imported-modules #:replace (imported-modules
compiled-modules)) compiled-modules))
@ -377,13 +378,21 @@ permission bits are kept."
(define* (package-file package (define* (package-file package
#:optional file #:optional file
#:key (system (%current-system)) (output "out")) #:key
system (output "out") target)
"Return as a monadic value the absolute file name of FILE within the "Return as a monadic value the absolute file name of FILE within the
OUTPUT directory of PACKAGE. When FILE is omitted, return the name of the OUTPUT directory of PACKAGE. When FILE is omitted, return the name of the
OUTPUT directory of PACKAGE." OUTPUT directory of PACKAGE. When TARGET is true, use it as a
cross-compilation target triplet."
(lambda (store) (lambda (store)
(let* ((drv (package-derivation store package system)) (define compute-derivation
(out (derivation->output-path drv output))) (if target
(cut package-cross-derivation <> <> target <>)
package-derivation))
(let* ((system (or system (%current-system)))
(drv (compute-derivation store package system))
(out (derivation->output-path drv output)))
(if file (if file
(string-append out "/" file) (string-append out "/" file)
out)))) out))))
@ -411,6 +420,9 @@ input list as a monadic value."
(define package->derivation (define package->derivation
(store-lift package-derivation)) (store-lift package-derivation))
(define package->cross-derivation
(store-lift package-cross-derivation))
(define origin->derivation (define origin->derivation
(store-lift package-source-derivation)) (store-lift package-source-derivation))

View File

@ -47,6 +47,7 @@
manifest-pattern? manifest-pattern?
manifest-remove manifest-remove
manifest-add
manifest-installed? manifest-installed?
manifest-matching-entries manifest-matching-entries
@ -157,12 +158,20 @@ omitted or #f, use the first output of PACKAGE."
('packages ((name version output path deps) ...))) ('packages ((name version output path deps) ...)))
(manifest (manifest
(map (lambda (name version output path deps) (map (lambda (name version output path deps)
(manifest-entry ;; Up to Guix 0.7 included, dependencies were listed as ("gmp"
(name name) ;; "/gnu/store/...-gmp") for instance. Discard the 'label' in
(version version) ;; such lists.
(output output) (let ((deps (match deps
(item path) (((labels directories) ...)
(dependencies deps))) directories)
((directories ...)
directories))))
(manifest-entry
(name name)
(version version)
(output output)
(item path)
(dependencies deps))))
name version output path deps))) name version output path deps)))
(_ (_
@ -196,6 +205,25 @@ must be a manifest-pattern."
(manifest-entries manifest) (manifest-entries manifest)
patterns))) patterns)))
(define (manifest-add manifest entries)
"Add a list of manifest ENTRIES to MANIFEST and return new manifest.
Remove MANIFEST entries that have the same name and output as ENTRIES."
(define (same-entry? entry name output)
(match entry
(($ <manifest-entry> entry-name _ entry-output _ ...)
(and (equal? name entry-name)
(equal? output entry-output)))))
(make-manifest
(append entries
(fold (lambda (entry result)
(match entry
(($ <manifest-entry> name _ out _ ...)
(filter (negate (cut same-entry? <> name out))
result))))
(manifest-entries manifest)
entries))))
(define (manifest-installed? manifest pattern) (define (manifest-installed? manifest pattern)
"Return #t if MANIFEST has an entry matching PATTERN (a manifest-pattern), "Return #t if MANIFEST has an entry matching PATTERN (a manifest-pattern),
#f otherwise." #f otherwise."

View File

@ -104,8 +104,7 @@ return PROFILE unchanged. The goal is to treat '-p ~/.guix-profile' as if
"Roll back to the previous generation of PROFILE." "Roll back to the previous generation of PROFILE."
(let* ((number (generation-number profile)) (let* ((number (generation-number profile))
(previous-number (previous-generation-number profile number)) (previous-number (previous-generation-number profile number))
(previous-generation (generation-file-name profile previous-number)) (previous-generation (generation-file-name profile previous-number)))
(manifest (string-append previous-generation "/manifest")))
(cond ((not (file-exists? profile)) ; invalid profile (cond ((not (file-exists? profile)) ; invalid profile
(leave (_ "profile '~a' does not exist~%") (leave (_ "profile '~a' does not exist~%")
profile)) profile))
@ -623,24 +622,6 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
(define (options->installable opts manifest) (define (options->installable opts manifest)
"Given MANIFEST, the current manifest, and OPTS, the result of 'args-fold', "Given MANIFEST, the current manifest, and OPTS, the result of 'args-fold',
return the new list of manifest entries." return the new list of manifest entries."
(define (deduplicate deps)
;; Remove duplicate entries from DEPS, a list of propagated inputs, where
;; each input is a name/path tuple.
(define (same? d1 d2)
(match d1
((_ p1)
(match d2
((_ p2) (eq? p1 p2))
(_ #f)))
((_ p1 out1)
(match d2
((_ p2 out2)
(and (string=? out1 out2)
(eq? p1 p2)))
(_ #f)))))
(delete-duplicates deps same?))
(define (package->manifest-entry* package output) (define (package->manifest-entry* package output)
(check-package-freshness package) (check-package-freshness package)
;; When given a package via `-e', install the first of its ;; When given a package via `-e', install the first of its
@ -659,19 +640,18 @@ return the new list of manifest entries."
(() (()
'()) '())
((_ ...) ((_ ...)
(let ((newest (find-newest-available-packages))) (filter-map (match-lambda
(filter-map (match-lambda (($ <manifest-entry> name version output path _)
(($ <manifest-entry> name version output path _) (and (any (cut regexp-exec <> name)
(and (any (cut regexp-exec <> name) upgrade-regexps)
upgrade-regexps) (upgradeable? name version path)
(upgradeable? name version path) (let ((output (or output "out")))
(let ((output (or output "out"))) (call-with-values
(call-with-values (lambda ()
(lambda () (specification->package+output name output))
(specification->package+output name output)) list))))
list)))) (_ #f))
(_ #f)) (manifest-entries manifest)))))
(manifest-entries manifest))))))
(define to-upgrade (define to-upgrade
(map (match-lambda (map (match-lambda
@ -762,11 +742,6 @@ removed from MANIFEST."
%default-options %default-options
#f)) #f))
(define (guile-missing?)
;; Return #t if %GUILE-FOR-BUILD is not available yet.
(let ((out (derivation->output-path (%guile-for-build))))
(not (valid-path? (%store) out))))
(define (ensure-default-profile) (define (ensure-default-profile)
;; Ensure the default profile symlink and directory exist and are ;; Ensure the default profile symlink and directory exist and are
;; writable. ;; writable.
@ -819,15 +794,8 @@ more information.~%"))
;; Process any install/remove/upgrade action from OPTS. ;; Process any install/remove/upgrade action from OPTS.
(define dry-run? (assoc-ref opts 'dry-run?)) (define dry-run? (assoc-ref opts 'dry-run?))
(define verbose? (assoc-ref opts 'verbose?))
(define profile (assoc-ref opts 'profile)) (define profile (assoc-ref opts 'profile))
(define (same-package? entry name output)
(match entry
(($ <manifest-entry> entry-name _ entry-output _ ...)
(and (equal? name entry-name)
(equal? output entry-output)))))
(define current-generation-number (define current-generation-number
(generation-number profile)) (generation-number profile))
@ -898,19 +866,8 @@ more information.~%"))
(let* ((manifest (profile-manifest profile)) (let* ((manifest (profile-manifest profile))
(install (options->installable opts manifest)) (install (options->installable opts manifest))
(remove (options->removable opts manifest)) (remove (options->removable opts manifest))
(entries (new (manifest-add (manifest-remove manifest remove)
(append install install)))
(fold (lambda (package result)
(match package
(($ <manifest-entry> name _ out _ ...)
(filter (negate
(cut same-package? <>
name out))
result))))
(manifest-entries
(manifest-remove manifest remove))
install)))
(new (make-manifest entries)))
(when (equal? profile %current-profile) (when (equal? profile %current-profile)
(ensure-default-profile)) (ensure-default-profile))
@ -940,7 +897,8 @@ more information.~%"))
(name (generation-file-name profile (name (generation-file-name profile
(+ 1 number)))) (+ 1 number))))
(and (build-derivations (%store) (list prof-drv)) (and (build-derivations (%store) (list prof-drv))
(let ((count (length entries))) (let* ((entries (manifest-entries new))
(count (length entries)))
(switch-symlinks name prof) (switch-symlinks name prof)
(switch-symlinks profile name) (switch-symlinks profile name)
(maybe-register-gc-root (%store) profile) (maybe-register-gc-root (%store) profile)
@ -1059,7 +1017,6 @@ more information.~%"))
(('search-paths) (('search-paths)
(let* ((manifest (profile-manifest profile)) (let* ((manifest (profile-manifest profile))
(entries (manifest-entries manifest)) (entries (manifest-entries manifest))
(packages (map manifest-entry-name entries))
(settings (search-path-environment-variables entries profile (settings (search-path-environment-variables entries profile
(const #f)))) (const #f))))
(format #t "~{~a~%~}" settings) (format #t "~{~a~%~}" settings)

View File

@ -393,15 +393,17 @@ converted to a space; sequences of more than one line break are preserved."
((#\newline) ((#\newline)
`(,column ,(+ 1 newlines) ,chars)) `(,column ,(+ 1 newlines) ,chars))
(else (else
(let ((chars (case newlines (let* ((spaces (if (and (pair? chars) (eqv? (car chars) #\.)) 2 1))
((0) chars) (chars (case newlines
((1) (cons #\space chars)) ((0) chars)
(else ((1)
(append (make-list newlines #\newline) chars)))) (append (make-list spaces #\space) chars))
(column (case newlines (else
((0) column) (append (make-list newlines #\newline) chars))))
((1) (+ 1 column)) (column (case newlines
(else 0)))) ((0) column)
((1) (+ spaces column))
(else 0))))
(let ((chars (cons chr chars)) (let ((chars (cons chr chars))
(column (+ 1 column))) (column (+ 1 column)))
(if (> column width) (if (> column width)
@ -414,7 +416,10 @@ converted to a space; sequences of more than one line break are preserved."
0 0
,(if (null? after) ,(if (null? after)
before before
(append before (cons #\newline (cdr after))))) (append before
(cons #\newline
(drop-while (cut eqv? #\space <>)
after)))))
`(,column 0 ,chars))) ; unbreakable `(,column 0 ,chars))) ; unbreakable
`(,column 0 ,chars))))))))) `(,column 0 ,chars)))))))))

View File

@ -1,5 +1,6 @@
# Set of available languages. # Set of available languages.
cs
de de
en@boldquot en@boldquot
en@quot en@quot

View File

@ -8,13 +8,10 @@ top_builddir = ../..
# These options get passed to xgettext. We want to catch standard # These options get passed to xgettext. We want to catch standard
# gettext uses, and SRFI-35 error condition messages. # gettext uses, and SRFI-35 error condition messages.
XGETTEXT_OPTIONS = \ XGETTEXT_OPTIONS = \
--no-wrap \
--language=Scheme --from-code=UTF-8 \ --language=Scheme --from-code=UTF-8 \
--keyword=_ --keyword=N_ \ --keyword=_ --keyword=N_ \
--keyword=message --keyword=message
MSGMERGE_OPTIONS = --no-wrap
COPYRIGHT_HOLDER = Ludovic Courtès COPYRIGHT_HOLDER = Ludovic Courtès
MSGID_BUGS_ADDRESS = ludo@gnu.org MSGID_BUGS_ADDRESS = ludo@gnu.org

1121
po/guix/cs.po Normal file

File diff suppressed because it is too large Load Diff

View File

@ -9,12 +9,9 @@ top_builddir = ../..
# These options get passed to xgettext. We want to catch exclusively package # These options get passed to xgettext. We want to catch exclusively package
# synopses and descriptions. # synopses and descriptions.
XGETTEXT_OPTIONS = \ XGETTEXT_OPTIONS = \
--no-wrap \
--language=Scheme --from-code=UTF-8 \ --language=Scheme --from-code=UTF-8 \
--keyword=synopsis --keyword=description --keyword=synopsis --keyword=description
MSGMERGE_OPTIONS = --no-wrap
COPYRIGHT_HOLDER = Ludovic Courtès COPYRIGHT_HOLDER = Ludovic Courtès
MSGID_BUGS_ADDRESS = ludo@gnu.org MSGID_BUGS_ADDRESS = ludo@gnu.org

View File

@ -39,6 +39,7 @@
;; For white-box testing. ;; For white-box testing.
(define gexp-inputs (@@ (guix gexp) gexp-inputs)) (define gexp-inputs (@@ (guix gexp) gexp-inputs))
(define gexp-native-inputs (@@ (guix gexp) gexp-native-inputs))
(define gexp->sexp (@@ (guix gexp) gexp->sexp)) (define gexp->sexp (@@ (guix gexp) gexp->sexp))
(define guile-for-build (define guile-for-build
@ -47,8 +48,9 @@
;; Make it the default. ;; Make it the default.
(%guile-for-build guile-for-build) (%guile-for-build guile-for-build)
(define (gexp->sexp* exp) (define* (gexp->sexp* exp #:optional target)
(run-with-store %store (gexp->sexp exp) (run-with-store %store (gexp->sexp exp
#:target target)
#:guile-for-build guile-for-build)) #:guile-for-build guile-for-build))
(define-syntax-rule (test-assertm name exp) (define-syntax-rule (test-assertm name exp)
@ -134,6 +136,29 @@
(e3 `(display ,txt))) (e3 `(display ,txt)))
(equal? `(begin ,e0 ,e1 ,e2 ,e3) (gexp->sexp* exp)))))) (equal? `(begin ,e0 ,e1 ,e2 ,e3) (gexp->sexp* exp))))))
(test-assert "ungexp + ungexp-native"
(let* ((exp (gexp (list (ungexp-native %bootstrap-guile)
(ungexp coreutils)
(ungexp-native glibc)
(ungexp binutils))))
(target "mips64el-linux")
(guile (derivation->output-path
(package-derivation %store %bootstrap-guile)))
(cu (derivation->output-path
(package-cross-derivation %store coreutils target)))
(libc (derivation->output-path
(package-derivation %store glibc)))
(bu (derivation->output-path
(package-cross-derivation %store binutils target))))
(and (lset= equal?
`((,%bootstrap-guile "out") (,glibc "out"))
(gexp-native-inputs exp))
(lset= equal?
`((,coreutils "out") (,binutils "out"))
(gexp-inputs exp))
(equal? `(list ,guile ,cu ,libc ,bu)
(gexp->sexp* exp target)))))
(test-assert "input list" (test-assert "input list"
(let ((exp (gexp (display (let ((exp (gexp (display
'(ungexp (list %bootstrap-guile coreutils))))) '(ungexp (list %bootstrap-guile coreutils)))))
@ -147,6 +172,28 @@
(equal? `(display '(,guile ,cu)) (equal? `(display '(,guile ,cu))
(gexp->sexp* exp))))) (gexp->sexp* exp)))))
(test-assert "input list + ungexp-native"
(let* ((target "mips64el-linux")
(exp (gexp (display
(cons '(ungexp-native (list %bootstrap-guile coreutils))
'(ungexp (list glibc binutils))))))
(guile (derivation->output-path
(package-derivation %store %bootstrap-guile)))
(cu (derivation->output-path
(package-derivation %store coreutils)))
(xlibc (derivation->output-path
(package-cross-derivation %store glibc target)))
(xbu (derivation->output-path
(package-cross-derivation %store binutils target))))
(and (lset= equal?
`((,%bootstrap-guile "out") (,coreutils "out"))
(gexp-native-inputs exp))
(lset= equal?
`((,glibc "out") (,binutils "out"))
(gexp-inputs exp))
(equal? `(display (cons '(,guile ,cu) '(,xlibc ,xbu)))
(gexp->sexp* exp target)))))
(test-assert "input list splicing" (test-assert "input list splicing"
(let* ((inputs (list (list glibc "debug") %bootstrap-guile)) (let* ((inputs (list (list glibc "debug") %bootstrap-guile))
(outputs (list (derivation->output-path (outputs (list (derivation->output-path
@ -161,6 +208,16 @@
(equal? (gexp->sexp* exp) (equal? (gexp->sexp* exp)
`(list ,@(cons 5 outputs)))))) `(list ,@(cons 5 outputs))))))
(test-assert "input list splicing + ungexp-native-splicing"
(let* ((inputs (list (list glibc "debug") %bootstrap-guile))
(exp (gexp (list (ungexp-native-splicing (cons (+ 2 3) inputs))))))
(and (lset= equal?
`((,glibc "debug") (,%bootstrap-guile "out"))
(gexp-native-inputs exp))
(null? (gexp-inputs exp))
(equal? (gexp->sexp* exp) ;native
(gexp->sexp* exp "mips64el-linux")))))
(test-assertm "gexp->file" (test-assertm "gexp->file"
(mlet* %store-monad ((exp -> (gexp (display (ungexp %bootstrap-guile)))) (mlet* %store-monad ((exp -> (gexp (display (ungexp %bootstrap-guile))))
(guile (package-file %bootstrap-guile)) (guile (package-file %bootstrap-guile))
@ -223,6 +280,55 @@
(mlet %store-monad ((drv mdrv)) (mlet %store-monad ((drv mdrv))
(return (string=? system (derivation-system drv)))))) (return (string=? system (derivation-system drv))))))
(test-assertm "gexp->derivation, cross-compilation"
(mlet* %store-monad ((target -> "mips64el-linux")
(exp -> (gexp (list (ungexp coreutils)
(ungexp output))))
(xdrv (gexp->derivation "foo" exp
#:target target))
(refs ((store-lift references)
(derivation-file-name xdrv)))
(xcu (package->cross-derivation coreutils
target))
(cu (package->derivation coreutils)))
(return (and (member (derivation-file-name xcu) refs)
(not (member (derivation-file-name cu) refs))))))
(test-assertm "gexp->derivation, ungexp-native"
(mlet* %store-monad ((target -> "mips64el-linux")
(exp -> (gexp (list (ungexp-native coreutils)
(ungexp output))))
(xdrv (gexp->derivation "foo" exp
#:target target))
(drv (gexp->derivation "foo" exp)))
(return (string=? (derivation-file-name drv)
(derivation-file-name xdrv)))))
(test-assertm "gexp->derivation, ungexp + ungexp-native"
(mlet* %store-monad ((target -> "mips64el-linux")
(exp -> (gexp (list (ungexp-native coreutils)
(ungexp glibc)
(ungexp output))))
(xdrv (gexp->derivation "foo" exp
#:target target))
(refs ((store-lift references)
(derivation-file-name xdrv)))
(xglibc (package->cross-derivation glibc target))
(cu (package->derivation coreutils)))
(return (and (member (derivation-file-name cu) refs)
(member (derivation-file-name xglibc) refs)))))
(test-assertm "gexp->derivation, ungexp-native + composed gexps"
(mlet* %store-monad ((target -> "mips64el-linux")
(exp0 -> (gexp (list 1 2
(ungexp coreutils))))
(exp -> (gexp (list 0 (ungexp-native exp0))))
(xdrv (gexp->derivation "foo" exp
#:target target))
(drv (gexp->derivation "foo" exp)))
(return (string=? (derivation-file-name drv)
(derivation-file-name xdrv)))))
(define shebang (define shebang
(string-append "#!" (derivation->output-path guile-for-build) (string-append "#!" (derivation->output-path guile-for-build)
"/bin/guile --no-auto-compile")) "/bin/guile --no-auto-compile"))
@ -268,8 +374,12 @@
(test-equal "sugar" (test-equal "sugar"
'(gexp (foo (ungexp bar) (ungexp baz "out") '(gexp (foo (ungexp bar) (ungexp baz "out")
(ungexp (chbouib 42)) (ungexp (chbouib 42))
(ungexp-splicing (list x y z)))) (ungexp-splicing (list x y z))
'#~(foo #$bar #$baz:out #$(chbouib 42) #$@(list x y z))) (ungexp-native foo) (ungexp-native foo "out")
(ungexp-native (chbouib 42))
(ungexp-native-splicing (list x y z))))
'#~(foo #$bar #$baz:out #$(chbouib 42) #$@(list x y z)
#+foo #+foo:out #+(chbouib 42) #+@(list x y z)))
(test-end "gexp") (test-end "gexp")

View File

@ -24,6 +24,7 @@
#:select (package-derivation %current-system)) #:select (package-derivation %current-system))
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (gnu packages bootstrap) #:use-module (gnu packages bootstrap)
#:use-module ((gnu packages base) #:select (coreutils))
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
@ -108,6 +109,30 @@
guile))) guile)))
#:guile-for-build (package-derivation %store %bootstrap-guile))) #:guile-for-build (package-derivation %store %bootstrap-guile)))
(test-assert "package-file, default system"
;; The default system should be the one at '>>=' time, not the one at
;; invocation time. See <http://bugs.gnu.org/18002>.
(run-with-store %store
(mlet* %store-monad
((system -> (%current-system))
(file (parameterize ((%current-system "foobar64-linux"))
(package-file coreutils "bin/ls")))
(cu (package->derivation coreutils)))
(return (string=? file
(string-append (derivation->output-path cu)
"/bin/ls"))))
#:guile-for-build (package-derivation %store %bootstrap-guile)))
(test-assert "package-file + package->cross-derivation"
(run-with-store %store
(mlet* %store-monad ((file (package-file coreutils "bin/ls"
#:target "foo64-gnu"))
(xcu (package->cross-derivation coreutils
"foo64-gnu")))
(let ((output (derivation->output-path xcu)))
(return (string=? file (string-append output "/bin/ls")))))
#:guile-for-build (package-derivation %store %bootstrap-guile)))
(test-assert "interned-file" (test-assert "interned-file"
(run-with-store %store (run-with-store %store
(mlet* %store-monad ((file -> (search-path %load-path "guix.scm")) (mlet* %store-monad ((file -> (search-path %load-path "guix.scm"))

View File

@ -40,6 +40,13 @@
;; Example manifest entries. ;; Example manifest entries.
(define guile-1.8.8
(manifest-entry
(name "guile")
(version "1.8.8")
(item "/gnu/store/...")
(output "out")))
(define guile-2.0.9 (define guile-2.0.9
(manifest-entry (manifest-entry
(name "guile") (name "guile")
@ -101,6 +108,20 @@
(null? (manifest-entries m3)) (null? (manifest-entries m3))
(null? (manifest-entries m4))))))) (null? (manifest-entries m4)))))))
(test-assert "manifest-add"
(let* ((m0 (manifest '()))
(m1 (manifest-add m0 (list guile-1.8.8)))
(m2 (manifest-add m1 (list guile-2.0.9)))
(m3 (manifest-add m2 (list guile-2.0.9:debug)))
(m4 (manifest-add m3 (list guile-2.0.9:debug))))
(and (match (manifest-entries m1)
((($ <manifest-entry> "guile" "1.8.8" "out")) #t)
(_ #f))
(match (manifest-entries m2)
((($ <manifest-entry> "guile" "2.0.9" "out")) #t)
(_ #f))
(equal? m3 m4))))
(test-assert "profile-derivation" (test-assert "profile-derivation"
(run-with-store %store (run-with-store %store
(mlet* %store-monad (mlet* %store-monad

View File

@ -67,6 +67,11 @@ interface, and powerful string processing.")
10) 10)
#\newline)) #\newline))
(test-equal "fill-paragraph, two spaces after period"
"First line. Second line"
(fill-paragraph "First line.
Second line" 24))
(test-equal "package-specification->name+version+output" (test-equal "package-specification->name+version+output"
'(("guile" #f "out") '(("guile" #f "out")
("guile" "2.0.9" "out") ("guile" "2.0.9" "out")