ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

Merge branch 'master' into core-updates

Browse source
This commit is contained in:
Mark H Weaver 2015-09-22 16:38:48 -04:00
commit bd90127ad4
89 changed files with 3913 additions and 457 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Makefile.am
View file

@ -102,6 +102,7 @@ MODULES = \
guix/import/cran.scm \
guix/import/hackage.scm \
guix/import/elpa.scm \
guix/scripts.scm \
guix/scripts/download.scm \
guix/scripts/build.scm \
guix/scripts/archive.scm \
@ -214,6 +215,7 @@ SCM_TESTS = \
tests/gremlin.scm \
tests/lint.scm \
tests/publish.scm \
tests/scripts.scm \
tests/size.scm \
tests/graph.scm \
tests/file-systems.scm \

1
THANKS
View file

@ -29,6 +29,7 @@ infrastructure help:
Cyprien Nicolas <cyprien@nicolas.tf>
Yutaka Niibe <gniibe@fsij.org>
Andrei Osipov <andrspv@gmail.com>
Petter <petter@mykolab.ch>
Adam Pribyl <pribyl@lowlevel.cz>
Pjotr Prins <pjotr.public12@thebird.nl>
Yakkala Yagnesh Raghava <hi@yagnesh.org>

4
doc/contributing.texi
View file

@ -206,6 +206,10 @@ Before submitting a patch that adds or modifies a package definition,
please run through this check list:
@enumerate
@item
Take some time to provide an adequate synopsis and description for the
package. @xref{Synopses and Descriptions}, for some guidelines.
@item
Run @code{guix lint @var{package}}, where @var{package} is the
name of the new or modified package, and fix any errors it reports

37
doc/emacs.texi
View file

@ -11,6 +11,7 @@ Guix convenient and fun.
* Package Management: Emacs Package Management. Managing packages and generations.
* Popup Interface: Emacs Popup Interface. Magit-like interface for guix commands.
* Prettify Mode: Emacs Prettify. Abbreviating @file{/gnu/store/@dots{}} file names.
* Build Log Mode: Emacs Build Log. Highlighting Guix build logs.
* Completions: Emacs Completions. Completing @command{guix} shell command.
@end menu
@ -571,6 +572,42 @@ mode hooks (@pxref{Hooks,,, emacs, The GNU Emacs Manual}), for example:
@end example
@node Emacs Build Log
@section Build Log Mode
GNU@tie{}Guix provides major and minor modes for highlighting build
logs. So when you have a file with a package build output---for
example, a file returned by @command{guix build --log-file @dots{}}
command (@pxref{Invoking guix build}), you may call @kbd{M-x
guix-build-log-mode} command in the buffer with this file. This major
mode highlights some lines specific to build output and provides the
following key bindings:
@table @kbd
@item M-n
Move to the next build phase.
@item M-p
Move to the previous build phase.
@item @key{TAB}
Toggle (show/hide) the body of the current build phase.
@item S-@key{TAB}
Toggle (show/hide) the bodies of all build phases.
@end table
There is also @kbd{M-x guix-build-log-minor-mode} which also provides
the same highlighting (but not key bindings). And as it is a minor
mode, it can be enabled in any buffer. For example, if you are building
some package in a shell buffer (@pxref{Interactive Shell,,, emacs, The
GNU Emacs Manual}), you may enable @command{guix-build-log-minor-mode}
to make it more colorful. Guix build output is rather specific, so this
new highlighting shouldn't conflict with the existing one.
@node Emacs Completions
@section Shell Completions

111
doc/guix.texi
View file

@ -45,9 +45,7 @@ Documentation License''.
@titlepage
@title GNU Guix Reference Manual
@subtitle Using the GNU Guix Functional Package Manager
@author Ludovic Courtès
@author Andreas Enge
@author Nikita Karetnikov
@author The GNU Guix Developers
@page
@vskip 0pt plus 1filll
@ -114,6 +112,7 @@ Emacs Interface
* Package Management: Emacs Package Management. Managing packages and generations.
* Popup Interface: Emacs Popup Interface. Magit-like interface for guix commands.
* Prettify Mode: Emacs Prettify. Abbreviating @file{/gnu/store/@dots{}} file names.
* Build Log Mode: Emacs Build Log. Highlighting Guix build logs.
* Completions: Emacs Completions. Completing @command{guix} shell command.
Programming Interface
@ -179,6 +178,7 @@ Services
* X Window:: Graphical display.
* Desktop Services:: D-Bus and desktop services.
* Database Services:: SQL databases.
* Web Services:: Web servers.
* Various Services:: Other services.
Packaging Guidelines
@ -186,6 +186,7 @@ Packaging Guidelines
* Software Freedom:: What may go into the distribution.
* Package Naming:: What's in a name?
* Version Numbers:: When the name is not enough.
* Synopses and Descriptions:: Helping users find the right package.
* Python Modules:: Taming the snake.
* Perl Modules:: Little pearls.
* Fonts:: Fond of fonts.
@ -1963,13 +1964,14 @@ package looks like this:
(define-public hello
(package
(name "hello")
(version "2.8")
(version "2.10")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/hello/hello-" version
".tar.gz"))
(sha256
(base32 "0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6"))))
(method url-fetch)
(uri (string-append "mirror://gnu/hello/hello-" version
".tar.gz"))
(sha256
(base32
"0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i"))))
(build-system gnu-build-system)
(arguments `(#:configure-flags '("--enable-silent-rules")))
(inputs `(("gawk" ,gawk)))
@ -2506,12 +2508,13 @@ This variable is exported by @code{(guix build-system ruby)}. It
implements the RubyGems build procedure used by Ruby packages, which
involves running @code{gem build} followed by @code{gem install}.
The @code{source} field of a package that uses this build system is
expected to reference a gem archive instead of a traditional tarball,
since this is the format that all Ruby developers use when releasing
their software. The build system unpacks the gem archive, potentially
patches the source, runs the test suite, repackages the gem, and
installs it.
The @code{source} field of a package that uses this build system
typically references a gem archive, since this is the format that Ruby
developers use when releasing their software. The build system unpacks
the gem archive, potentially patches the source, runs the test suite,
repackages the gem, and installs it. Additionally, directories and
tarballs may be referenced to allow building unreleased gems from Git or
a traditional source release tarball.
Which Ruby package is used can be specified with the @code{#:ruby}
parameter. A list of additional flags to be passed to the @command{gem}
@ -4217,8 +4220,11 @@ Identify inputs that should most likely be native inputs.
@item source
@itemx home-page
@itemx source-file-name
Probe @code{home-page} and @code{source} URLs and report those that are
invalid.
invalid. Check that the source file name is meaningful, e.g. is not
just a version number or ``git-checkout'', and should not have a
@code{file-name} declared (@pxref{origin Reference}).
@item formatting
Warn about obvious source code formatting issues: trailing white space,
@ -5289,16 +5295,11 @@ variables.
@defvr {Scheme Variable} %base-file-systems
These are essential file systems that are required on normal systems,
such as @var{%devtmpfs-file-system} and @var{%immutable-store} (see
such as @var{%pseudo-terminal-file-system} and @var{%immutable-store} (see
below.) Operating system declarations should always contain at least
these.
@end defvr
@defvr {Scheme Variable} %devtmpfs-file-system
The @code{devtmpfs} file system to be mounted on @file{/dev}. This is a
requirement for udev (@pxref{Base Services, @code{udev-service}}).
@end defvr
@defvr {Scheme Variable} %pseudo-terminal-file-system
This is the file system to be mounted as @file{/dev/pts}. It supports
@dfn{pseudo-terminals} created @i{via} @code{openpty} and similar
@ -7154,6 +7155,7 @@ needed is to review and apply the patch.
* Software Freedom:: What may go into the distribution.
* Package Naming:: What's in a name?
* Version Numbers:: When the name is not enough.
* Synopses and Descriptions:: Helping users find the right package.
* Python Modules:: Taming the snake.
* Perl Modules:: Little pearls.
* Fonts:: Fond of fonts.
@ -7231,24 +7233,71 @@ For instance, the versions 2.24.20 and 3.9.12 of GTK+ may be packaged as follows
@example
(define-public gtk+
(package
(name "gtk+")
(version "3.9.12")
...))
(name "gtk+")
(version "3.9.12")
...))
(define-public gtk+-2
(package
(name "gtk+")
(version "2.24.20")
...))
(name "gtk+")
(version "2.24.20")
...))
@end example
If we also wanted GTK+ 3.8.2, this would be packaged as
@example
(define-public gtk+-3.8
(package
(name "gtk+")
(version "3.8.2")
...))
(name "gtk+")
(version "3.8.2")
...))
@end example
@node Synopses and Descriptions
@subsection Synopses and Descriptions
As we have seen before, each package in GNU@tie{}Guix includes a
synopsis and a description (@pxref{Defining Packages}). Synopses and
descriptions are important: They are what @command{guix package
--search} searches, and a crucial piece of information to help users
determine whether a given package suits their needs. Consequently,
packagers should pay attention to what goes into them.
Synopses must start with a capital letter and must not end with a
period. They must not start with ``a'' or ``the'', which usually does
not bring anything; for instance, prefer ``File-frobbing tool'' over ``A
tool that frobs files''. The synopsis should say what the package
is---e.g., ``Core GNU utilities (file, text, shell)''---or what it is
used for---e.g., the synopsis for GNU@tie{}grep is ``Print lines
matching a pattern''.
Keep in mind that the synopsis must be meaningful for a very wide
audience. For example, ``Manipulate alignments in the SAM format''
might make sense for a seasoned bioinformatics researcher, but might be
fairly unhelpful or even misleading to a non-specialized audience. It
is a good idea to come up with a synopsis that gives an idea of the
application domain of the package. In this example, this might give
something like ``Manipulate nucleotide sequence alignments'', which
hopefully gives the user a better idea of whether this is what they are
looking for.
@cindex Texinfo markup, in package descriptions
Descriptions should take between five and ten lines. Use full
sentences, and avoid using acronyms without first introducing them.
Descriptions can include Texinfo markup, which is useful to introduce
ornaments such as @code{@@code} or @code{@@dfn}, bullet lists, or
hyperlinks (@pxref{Overview, overview of Texinfo,, texinfo, GNU
Texinfo}). User interfaces such as @command{guix package --show} take
care of rendering it appropriately.
Synopses and descriptions are translated by volunteers
@uref{http://translationproject.org/domain/guix-packages.html, at the
Translation Project} so that as many users as possible can read them in
their native language. User interfaces search them and display them in
the language specified by the current locale.
Translation is a lot of work so, as a packager, please pay even more
attention to your synopses and descriptions as every change may entail
additional work for translators.
@node Python Modules
@subsection Python Modules

5
doc/package-hello.scm
View file

@ -4,13 +4,14 @@
(package
(name "hello")
(version "2.8")
(version "2.10")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/hello/hello-" version
".tar.gz"))
(sha256
(base32 "0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6"))))
(base32
"0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i"))))
(build-system gnu-build-system)
(synopsis "Hello, GNU world: An example GNU package")
(description "Guess what GNU Hello prints!")

3
emacs.am
View file

@ -21,9 +21,12 @@ AUTOLOADS = emacs/guix-autoloads.el
ELFILES = \
emacs/guix-backend.el \
emacs/guix-base.el \
emacs/guix-build-log.el \
emacs/guix-command.el \
emacs/guix-emacs.el \
emacs/guix-external.el \
emacs/guix-geiser.el \
emacs/guix-guile.el \
emacs/guix-help-vars.el \
emacs/guix-history.el \
emacs/guix-info.el \

63
emacs/guix-backend.el
View file

@ -1,6 +1,6 @@
;;; guix-backend.el --- Communication with Geiser
;;; guix-backend.el --- Making and using Guix REPL
;; Copyright © 2014 Alex Kost <alezost@gmail.com>
;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
;; This file is part of GNU Guix.
@ -19,9 +19,10 @@
;;; Commentary:
;; This file provides the code for interacting with Guile using Geiser.
;; This file provides the code for interacting with Guile using Guix REPL
;; (Geiser REPL with some guix-specific additions).
;; By default (if `guix-use-guile-server' is non-nil) 2 Geiser REPLs are
;; By default (if `guix-use-guile-server' is non-nil) 2 Guix REPLs are
;; started. The main one (with "guile --listen" process) is used for
;; "interacting" with a user - for showing a progress of
;; installing/deleting Guix packages. The second (internal) REPL is
@ -52,6 +53,8 @@
;;; Code:
(require 'geiser-mode)
(require 'geiser-guile)
(require 'guix-geiser)
(require 'guix-config)
(require 'guix-emacs)
@ -305,46 +308,15 @@ additional internal REPL if it exists."
(defvar guix-operation-buffer nil
"Buffer from which the latest Guix operation was performed.")
(defun guix-make-guile-expression (fun &rest args)
"Return string containing a guile expression for calling FUN with ARGS."
(format "(%S %s)" fun
(mapconcat
(lambda (arg)
(cond
((null arg) "'()")
((or (eq arg t)
;; An ugly hack to separate 'false' from nil
(equal arg 'f)
(keywordp arg))
(concat "#" (prin1-to-string arg t)))
((or (symbolp arg) (listp arg))
(concat "'" (prin1-to-string arg)))
(t (prin1-to-string arg))))
args
" ")))
(defun guix-eval (str)
"Evaluate STR with guile expression using Guix REPL.
See `guix-geiser-eval' for details."
(guix-geiser-eval str (guix-get-repl-buffer 'internal)))
(defun guix-eval (str &optional wrap)
"Evaluate guile expression STR.
If WRAP is non-nil, wrap STR into (begin ...) form.
Return a list of strings with result values of evaluation."
(with-current-buffer (guix-get-repl-buffer 'internal)
(let* ((wrapped (if wrap (geiser-debug--wrap-region str) str))
(code `(:eval (:scm ,wrapped)))
(ret (geiser-eval--send/wait code)))
(if (geiser-eval--retort-error ret)
(error "Error in evaluating guile expression: %s"
(geiser-eval--retort-output ret))
(cdr (assq 'result ret))))))
(defun guix-eval-read (str &optional wrap)
"Evaluate guile expression STR.
For the meaning of WRAP, see `guix-eval'.
Return elisp expression of the first result value of evaluation."
;; Parsing scheme code with elisp `read' is probably not the best idea.
(read (replace-regexp-in-string
"#f\\|#<unspecified>" "nil"
(replace-regexp-in-string
"#t" "t" (car (guix-eval str wrap))))))
(defun guix-eval-read (str)
"Evaluate STR with guile expression using Guix REPL.
See `guix-geiser-eval-read' for details."
(guix-geiser-eval-read str (guix-get-repl-buffer 'internal)))
(defun guix-eval-in-repl (str &optional operation-buffer operation-type)
"Switch to Guix REPL and evaluate STR with guile expression there.
@ -358,10 +330,7 @@ successful executing of the current operation,
(setq guix-repl-operation-p t
guix-repl-operation-type operation-type
guix-operation-buffer operation-buffer)
(let ((repl (guix-get-repl-buffer)))
(with-current-buffer repl
(geiser-repl--send str))
(geiser-repl--switch-to-buffer repl)))
(guix-geiser-eval-in-repl str (guix-get-repl-buffer)))
(provide 'guix-backend)

17
emacs/guix-base.el
View file

@ -30,6 +30,7 @@
(require 'cl-lib)
(require 'guix-profiles)
(require 'guix-backend)
(require 'guix-guile)
(require 'guix-utils)
(require 'guix-history)
(require 'guix-messages)
@ -414,6 +415,7 @@ following keywords are available:
(buf-str (concat buf-type-str " buffer"))
(prefix (concat "guix-" entry-type-str "-" buf-type-str))
(group (intern prefix))
(faces-group (intern (concat prefix "-faces")))
(mode-map-str (concat prefix "-mode-map"))
(parent-mode (intern (concat "guix-" buf-type-str "-mode")))
(mode (intern (concat prefix "-mode")))
@ -442,6 +444,10 @@ following keywords are available:
:prefix ,(concat prefix "-")
:group ',(intern (concat "guix-" buf-type-str)))
(defgroup ,faces-group nil
,(concat "Faces for " buf-type-str " buffer with " entry-str ".")
:group ',(intern (concat "guix-" buf-type-str "-faces")))
(defcustom ,buf-name-var ,buf-name-val
,(concat "Default name of the " buf-str " for displaying " entry-str ".")
:type 'string
@ -789,7 +795,7 @@ GENERATION is a generation number of `guix-profile' profile."
(defface guix-operation-option-key
'((t :inherit font-lock-warning-face))
"Face used for the keys of operation options."
:group 'guix)
:group 'guix-faces)
(defcustom guix-operation-confirm t
"If nil, do not prompt to confirm an operation."
@ -1129,9 +1135,12 @@ The function is called with a single argument - a command line string."
(defun guix-command-output (args)
"Return string with 'guix ARGS ...' output."
(guix-eval-read
(apply #'guix-make-guile-expression
'guix-command-output args)))
(cl-multiple-value-bind (output error)
(guix-eval (apply #'guix-make-guile-expression
'guix-command-output args))
;; Remove trailing new space from the error string.
(message (replace-regexp-in-string "\n\\'" "" (read error)))
(read output)))
(defun guix-help-string (&optional commands)
"Return string with 'guix COMMANDS ... --help' output."

333
emacs/guix-build-log.el Normal file
View file

@ -0,0 +1,333 @@
;;; guix-build-log.el --- Major and minor modes for build logs -*- lexical-binding: t -*-
;; Copyright © 2015 Alex Kost <alezost@gmail.com>
;; This file is part of GNU Guix.
;; GNU Guix is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Guix is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This file provides a major mode (`guix-build-log-mode') and a minor mode
;; (`guix-build-log-minor-mode') for highlighting Guix build logs.
;;; Code:
(defgroup guix-build-log nil
"Settings for `guix-build-log-mode'."
:group 'guix)
(defgroup guix-build-log-faces nil
"Faces for `guix-build-log-mode'."
:group 'guix-build-log
:group 'guix-faces)
(defface guix-build-log-title-head
'((t :inherit font-lock-keyword-face))
"Face for '@' symbol of a log title."
:group 'guix-build-log-faces)
(defface guix-build-log-title-start
'((t :inherit guix-build-log-title-head))
"Face for a log title denoting a start of a process."
:group 'guix-build-log-faces)
(defface guix-build-log-title-success
'((t :inherit guix-build-log-title-head))
"Face for a log title denoting a successful end of a process."
:group 'guix-build-log-faces)
(defface guix-build-log-title-fail
'((t :inherit error))
"Face for a log title denoting a failed end of a process."
:group 'guix-build-log-faces)
(defface guix-build-log-title-end
'((t :inherit guix-build-log-title-head))
"Face for a log title denoting an undefined end of a process."
:group 'guix-build-log-faces)
(defface guix-build-log-phase-name
'((t :inherit font-lock-function-name-face))
"Face for a phase name."
:group 'guix-build-log-faces)
(defface guix-build-log-phase-start
'((default :weight bold)
(((class grayscale) (background light)) :foreground "Gray90")
(((class grayscale) (background dark)) :foreground "DimGray")
(((class color) (min-colors 16) (background light))
:foreground "DarkGreen")
(((class color) (min-colors 16) (background dark))
:foreground "LimeGreen")
(((class color) (min-colors 8)) :foreground "green"))
"Face for the start line of a phase."
:group 'guix-build-log-faces)
(defface guix-build-log-phase-end
'((((class grayscale) (background light)) :foreground "Gray90")
(((class grayscale) (background dark)) :foreground "DimGray")
(((class color) (min-colors 16) (background light))
:foreground "ForestGreen")
(((class color) (min-colors 16) (background dark))
:foreground "LightGreen")
(((class color) (min-colors 8)) :foreground "green")
(t :weight bold))
"Face for the end line of a phase."
:group 'guix-build-log-faces)
(defface guix-build-log-phase-success
'((t))
"Face for the 'succeeded' word of a phase line."
:group 'guix-build-log-faces)
(defface guix-build-log-phase-fail
'((t :inherit error))
"Face for the 'failed' word of a phase line."
:group 'guix-build-log-faces)
(defface guix-build-log-phase-seconds
'((t :inherit font-lock-constant-face))
"Face for the number of seconds for a phase."
:group 'guix-build-log-faces)
(defcustom guix-build-log-mode-hook
;; Not using `compilation-minor-mode' because it rebinds some standard
;; keys, including M-n/M-p.
'(compilation-shell-minor-mode view-mode)
"Hook run after `guix-build-log-mode' is entered."
:type 'hook
:group 'guix-build-log)
(defvar guix-build-log-phase-name-regexp "`\\([^']+\\)'"
"Regexp for a phase name.")
(defvar guix-build-log-phase-start-regexp
(concat "^starting phase " guix-build-log-phase-name-regexp)
"Regexp for the start line of a 'build' phase.")
(defun guix-build-log-title-regexp (&optional state)
"Return regexp for the log title.
STATE is a symbol denoting a state of the title. It should be
`start', `fail', `success' or `nil' (for a regexp matching any
state)."
(let* ((word-rx (rx (1+ (any word "-"))))
(state-rx (cond ((eq state 'start) (concat word-rx "started"))
((eq state 'success) (concat word-rx "succeeded"))
((eq state 'fail) (concat word-rx "failed"))
(t word-rx))))
(rx-to-string
`(and bol (group "@") " " (group (regexp ,state-rx)))
t)))
(defun guix-build-log-phase-end-regexp (&optional state)
"Return regexp for the end line of a 'build' phase.
STATE is a symbol denoting how a build phase was ended. It should be
`fail', `success' or `nil' (for a regexp matching any state)."
(let ((state-rx (cond ((eq state 'success) "succeeded")
((eq state 'fail) "failed")
(t (regexp-opt '("succeeded" "failed"))))))
(rx-to-string
`(and bol "phase " (regexp ,guix-build-log-phase-name-regexp)
" " (group (regexp ,state-rx)) " after "
(group (1+ digit)) " seconds")
t)))
(defvar guix-build-log-phase-end-regexp
;; For efficiency, it is better to have a regexp for the general line
;; of the phase end, then to call the function all the time.
(guix-build-log-phase-end-regexp)
"Regexp for the end line of a 'build' phase.")
(defvar guix-build-log-font-lock-keywords
`((,(guix-build-log-title-regexp 'start)
(1 'guix-build-log-title-head)
(2 'guix-build-log-title-start))
(,(guix-build-log-title-regexp 'success)
(1 'guix-build-log-title-head)
(2 'guix-build-log-title-success))
(,(guix-build-log-title-regexp 'fail)
(1 'guix-build-log-title-head)
(2 'guix-build-log-title-fail))
(,(guix-build-log-title-regexp)
(1 'guix-build-log-title-head)
(2 'guix-build-log-title-end))
(,guix-build-log-phase-start-regexp
(0 'guix-build-log-phase-start)
(1 'guix-build-log-phase-name prepend))
(,(guix-build-log-phase-end-regexp 'success)
(0 'guix-build-log-phase-end)
(1 'guix-build-log-phase-name prepend)
(2 'guix-build-log-phase-success prepend)
(3 'guix-build-log-phase-seconds prepend))
(,(guix-build-log-phase-end-regexp 'fail)
(0 'guix-build-log-phase-end)
(1 'guix-build-log-phase-name prepend)
(2 'guix-build-log-phase-fail prepend)
(3 'guix-build-log-phase-seconds prepend)))
"A list of `font-lock-keywords' for `guix-build-log-mode'.")
(defvar guix-build-log-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map special-mode-map)
(define-key map (kbd "M-n") 'guix-build-log-next-phase)
(define-key map (kbd "M-p") 'guix-build-log-previous-phase)
(define-key map (kbd "TAB") 'guix-build-log-phase-toggle)
(define-key map (kbd "<tab>") 'guix-build-log-phase-toggle)
(define-key map (kbd "<backtab>") 'guix-build-log-phase-toggle-all)
(define-key map [(shift tab)] 'guix-build-log-phase-toggle-all)
map)
"Keymap for `guix-build-log-mode' buffers.")
(defun guix-build-log-phase-start (&optional with-header?)
"Return the start point of the current build phase.
If WITH-HEADER? is non-nil, do not skip 'starting phase ...' header.
Return nil, if there is no phase start before the current point."
(save-excursion
(end-of-line)
(when (re-search-backward guix-build-log-phase-start-regexp nil t)
(unless with-header? (end-of-line))
(point))))
(defun guix-build-log-phase-end ()
"Return the end point of the current build phase."
(save-excursion
(beginning-of-line)
(when (re-search-forward guix-build-log-phase-end-regexp nil t)
(point))))
(defun guix-build-log-phase-hide ()
"Hide the body of the current build phase."
(interactive)
(let ((beg (guix-build-log-phase-start))
(end (guix-build-log-phase-end)))
(when (and beg end)
;; If not on the header line, move to it.
(when (and (> (point) beg)
(< (point) end))
(goto-char (guix-build-log-phase-start t)))
(remove-overlays beg end 'invisible t)
(let ((o (make-overlay beg end)))
(overlay-put o 'evaporate t)
(overlay-put o 'invisible t)))))
(defun guix-build-log-phase-show ()
"Show the body of the current build phase."
(interactive)
(let ((beg (guix-build-log-phase-start))
(end (guix-build-log-phase-end)))
(when (and beg end)
(remove-overlays beg end 'invisible t))))
(defun guix-build-log-phase-hidden-p ()
"Return non-nil, if the body of the current build phase is hidden."
(let ((beg (guix-build-log-phase-start)))
(and beg
(cl-some (lambda (o)
(overlay-get o 'invisible))
(overlays-at beg)))))
(defun guix-build-log-phase-toggle-function ()
"Return a function to toggle the body of the current build phase."
(if (guix-build-log-phase-hidden-p)
#'guix-build-log-phase-show
#'guix-build-log-phase-hide))
(defun guix-build-log-phase-toggle ()
"Show/hide the body of the current build phase."
(interactive)
(funcall (guix-build-log-phase-toggle-function)))
(defun guix-build-log-phase-toggle-all ()
"Show/hide the bodies of all build phases."
(interactive)
(save-excursion
;; Some phases may be hidden, and some shown. Whether to hide or to
;; show them, it is determined by the state of the first phase here.
(goto-char (point-min))
(guix-build-log-next-phase)
(let ((fun (guix-build-log-phase-toggle-function)))
(while (re-search-forward guix-build-log-phase-start-regexp nil t)
(funcall fun)))))
(defun guix-build-log-next-phase (&optional arg)
"Move to the next build phase.
With ARG, do it that many times. Negative ARG means move
backward."
(interactive "^p")
(if arg
(when (zerop arg) (user-error "Try again"))
(setq arg 1))
(let ((search-fun (if (> arg 0)
#'re-search-forward
#'re-search-backward))
(n (abs arg))
found last-found)
(save-excursion
(end-of-line (if (> arg 0) 1 0)) ; skip the current line
(while (and (not (zerop n))
(setq found
(funcall search-fun
guix-build-log-phase-start-regexp
nil t)))
(setq n (1- n)
last-found found)))
(when last-found
(goto-char last-found)
(forward-line 0))
(or found
(user-error (if (> arg 0)
"No next build phase"
"No previous build phase")))))
(defun guix-build-log-previous-phase (&optional arg)
"Move to the previous build phase.
With ARG, do it that many times. Negative ARG means move
forward."
(interactive "^p")
(guix-build-log-next-phase (- (or arg 1))))
;;;###autoload
(define-derived-mode guix-build-log-mode special-mode
"Guix-Build-Log"
"Major mode for viewing Guix build logs.
\\{guix-build-log-mode-map}"
(setq font-lock-defaults '(guix-build-log-font-lock-keywords t)))
;;;###autoload
(define-minor-mode guix-build-log-minor-mode
"Toggle Guix Build Log minor mode.
With a prefix argument ARG, enable Guix Build Log minor mode if
ARG is positive, and disable it otherwise. If called from Lisp,
enable the mode if ARG is omitted or nil.
When Guix Build Log minor mode is enabled, it highlights build
log in the current buffer. This mode can be enabled
programmatically using hooks:
(add-hook 'shell-mode-hook 'guix-build-log-minor-mode)"
:init-value nil
:lighter " Guix-Build-Log"
:group 'guix-build-log
(if guix-build-log-minor-mode
(font-lock-add-keywords nil guix-build-log-font-lock-keywords)
(font-lock-remove-keywords nil guix-build-log-font-lock-keywords))
(when font-lock-mode
(font-lock-fontify-buffer)))
(provide 'guix-build-log)
;;; guix-build-log.el ends here

26
emacs/guix-command.el
View file

@ -65,6 +65,7 @@
(require 'guix-help-vars)
(require 'guix-read)
(require 'guix-base)
(require 'guix-guile)
(require 'guix-external)
(defgroup guix-commands nil
@ -305,9 +306,9 @@ to be modified."
(defun guix-command-improve-argument (argument improvers)
"Return ARGUMENT modified with IMPROVERS."
(or (guix-any (lambda (improver)
(funcall improver argument))
improvers)
(or (cl-some (lambda (improver)
(funcall improver argument))
improvers)
argument))
(defun guix-command-improve-arguments (arguments commands)
@ -497,7 +498,10 @@ to be modified."
"List of default 'execute' action arguments.")
(defvar guix-command-additional-execute-arguments
`((("graph")
`((("build")
,(guix-command-make-argument
:name "log" :char ?l :doc "View build log"))
(("graph")
,(guix-command-make-argument
:name "view" :char ?v :doc "View graph")))
"Alist of guix commands and additional 'execute' action arguments.")
@ -518,6 +522,8 @@ to be modified."
("repl" . guix-run-environment-command-in-repl))
(("pull")
("repl" . guix-run-pull-command-in-repl))
(("build")
("log" . guix-run-view-build-log))
(("graph")
("view" . guix-run-view-graph)))
"Alist of guix commands and alists of special executers for them.
@ -556,6 +562,18 @@ Perform pull-specific actions after operation, see
(apply #'guix-make-guile-expression 'guix-command args)
nil 'pull))
(defun guix-run-view-build-log (args)
"Add --log-file to ARGS, run 'guix ARGS ...' build command, and
open the log file(s)."
(let* ((args (if (member "--log-file" args)
args
(apply #'list (car args) "--log-file" (cdr args))))
(output (guix-command-output args))
(files (split-string output "\n" t)))
(dolist (file files)
(guix-find-file-or-url file)
(guix-build-log-mode))))
(defun guix-run-view-graph (args)
"Run 'guix ARGS ...' graph command, make the image and open it."
(let* ((graph-file (guix-dot-file-name))

97
emacs/guix-geiser.el Normal file
View file

@ -0,0 +1,97 @@
;;; guix-geiser.el --- Interacting with Geiser -*- lexical-binding: t -*-
;; Copyright © 2015 Alex Kost <alezost@gmail.com>
;; This file is part of GNU Guix.
;; GNU Guix is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Guix is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This file provides functions to evaluate guile code using Geiser.
;;; Code:
(require 'geiser-mode)
(require 'guix-guile)
(defun guix-geiser-repl ()
"Return the current Geiser REPL."
(or geiser-repl--repl
(geiser-repl--repl/impl 'guile)
(error "Geiser REPL not found")))
(defun guix-geiser-eval (str &optional repl)
"Evaluate STR with guile expression using Geiser REPL.
If REPL is nil, use the current Geiser REPL.
Return a list of strings with result values of evaluation."
(with-current-buffer (or repl (guix-geiser-repl))
(let ((res (geiser-eval--send/wait `(:eval (:scm ,str)))))
(if (geiser-eval--retort-error res)
(error "Error in evaluating guile expression: %s"
(geiser-eval--retort-output res))
(cdr (assq 'result res))))))
(defun guix-geiser-eval-read (str &optional repl)
"Evaluate STR with guile expression using Geiser REPL.
Return elisp expression of the first result value of evaluation."
;; Parsing scheme code with elisp `read' is probably not the best idea.
(read (replace-regexp-in-string
"#f\\|#<unspecified>" "nil"
(replace-regexp-in-string
"#t" "t" (car (guix-geiser-eval str repl))))))
(defun guix-repl-send (cmd &optional save-history)
"Send CMD input string to the current REPL buffer.
This is the same as `geiser-repl--send', but with SAVE-HISTORY
argument. If SAVE-HISTORY is non-nil, save CMD in the REPL
history."
(when (and cmd (eq major-mode 'geiser-repl-mode))
(geiser-repl--prepare-send)
(goto-char (point-max))
(comint-kill-input)
(insert cmd)
(let ((comint-input-filter (if save-history
comint-input-filter
'ignore)))
(comint-send-input nil t))))
(defun guix-geiser-eval-in-repl (str &optional repl no-history no-display)
"Switch to Geiser REPL and evaluate STR with guile expression there.
If NO-HISTORY is non-nil, do not save STR in the REPL history.
If NO-DISPLAY is non-nil, do not switch to the REPL buffer."
(let ((repl (or repl (guix-geiser-repl))))
(with-current-buffer repl
;; XXX Since Geiser 0.8, `geiser-repl--send' has SAVE-HISTORY
;; argument, so use this function eventually and remove
;; `guix-repl-send'.
(guix-repl-send str (not no-history)))
(unless no-display
(geiser-repl--switch-to-buffer repl))))
(defun guix-geiser-call (proc &rest args)
"Call (PROC ARGS ...) synchronously using the current Geiser REPL.
PROC and ARGS should be strings."
(guix-geiser-eval
(apply #'guix-guile-make-call-expression proc args)))
(defun guix-geiser-call-in-repl (proc &rest args)
"Call (PROC ARGS ...) in the current Geiser REPL.
PROC and ARGS should be strings."
(guix-geiser-eval-in-repl
(apply #'guix-guile-make-call-expression proc args)))
(provide 'guix-geiser)
;;; guix-geiser.el ends here

54
emacs/guix-guile.el Normal file
View file

@ -0,0 +1,54 @@
;;; guix-guile.el --- Auxiliary tools for working with guile code -*- lexical-binding: t -*-
;; Copyright © 2015 Alex Kost <alezost@gmail.com>
;; This file is part of GNU Guix.
;; GNU Guix is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Guix is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This file provides functions for parsing guile code, making guile
;; expressions, etc.
;;; Code:
(defun guix-guile-make-call-expression (proc &rest args)
"Return \"(PROC ARGS ...)\" string.
PROC and ARGS should be strings."
(format "(%s %s)"
proc
(mapconcat #'identity args " ")))
(defun guix-make-guile-expression (fun &rest args)
"Return string containing a guile expression for calling FUN with ARGS."
(format "(%S %s)" fun
(mapconcat
(lambda (arg)
(cond
((null arg) "'()")
((or (eq arg t)
;; An ugly hack to separate 'false' from nil.
(equal arg 'f)
(keywordp arg))
(concat "#" (prin1-to-string arg t)))
((or (symbolp arg) (listp arg))
(concat "'" (prin1-to-string arg)))
(t (prin1-to-string arg))))
args
" ")))
(provide 'guix-guile)
;;; guix-guile.el ends here

49
emacs/guix-info.el
View file

@ -33,25 +33,30 @@
:prefix "guix-info-"
:group 'guix)
(defgroup guix-info-faces nil
"Faces for info buffers."
:group 'guix-info
:group 'guix-faces)
(defface guix-info-param-title
'((t :inherit font-lock-type-face))
"Face used for titles of parameters."
:group 'guix-info)
:group 'guix-info-faces)
(defface guix-info-file-path
'((t :inherit link))
"Face used for file paths."
:group 'guix-info)
:group 'guix-info-faces)
(defface guix-info-url
'((t :inherit link))
"Face used for URLs."
:group 'guix-info)
:group 'guix-info-faces)
(defface guix-info-time
'((t :inherit font-lock-constant-face))
"Face used for timestamps."
:group 'guix-info)
:group 'guix-info-faces)
(defface guix-info-action-button
'((((type x w32 ns) (class color))
@ -59,7 +64,7 @@
:background "lightgrey" :foreground "black")
(t :inherit button))
"Face used for action buttons."
:group 'guix-info)
:group 'guix-info-faces)
(defface guix-info-action-button-mouse
'((((type x w32 ns) (class color))
@ -67,7 +72,7 @@
:background "grey90" :foreground "black")
(t :inherit highlight))
"Mouse face used for action buttons."
:group 'guix-info)
:group 'guix-info-faces)
(defcustom guix-info-ignore-empty-vals nil
"If non-nil, do not display parameters with nil values."
@ -414,43 +419,43 @@ See `insert-text-button' for the meaning of PROPERTIES."
'((((type tty pc) (class color)) :weight bold)
(t :height 1.6 :weight bold :inherit variable-pitch))
"Face for package name and version headings."
:group 'guix-package-info)
:group 'guix-package-info-faces)
(defface guix-package-info-name
'((t :inherit font-lock-keyword-face))
"Face used for a name of a package."
:group 'guix-package-info)
:group 'guix-package-info-faces)
(defface guix-package-info-name-button
'((t :inherit button))
"Face used for a full name that can be used to describe a package."
:group 'guix-package-info)
:group 'guix-package-info-faces)
(defface guix-package-info-version
'((t :inherit font-lock-builtin-face))
"Face used for a version of a package."
:group 'guix-package-info)
:group 'guix-package-info-faces)
(defface guix-package-info-synopsis
'((((type tty pc) (class color)) :weight bold)
(t :height 1.1 :weight bold :inherit variable-pitch))
"Face used for a synopsis of a package."
:group 'guix-package-info)
:group 'guix-package-info-faces)
(defface guix-package-info-description
'((t))
"Face used for a description of a package."
:group 'guix-package-info)
:group 'guix-package-info-faces)
(defface guix-package-info-license
'((t :inherit font-lock-string-face))
"Face used for a license of a package."
:group 'guix-package-info)
:group 'guix-package-info-faces)
(defface guix-package-info-location
'((t :inherit link))
"Face used for a location of a package."
:group 'guix-package-info)
:group 'guix-package-info-faces)
(defface guix-package-info-installed-outputs
'((default :weight bold)
@ -462,17 +467,17 @@ See `insert-text-button' for the meaning of PROPERTIES."
:foreground "green")
(t :underline t))
"Face used for installed outputs of a package."
:group 'guix-package-info)
:group 'guix-package-info-faces)
(defface guix-package-info-uninstalled-outputs
'((t :weight bold))
"Face used for uninstalled outputs of a package."
:group 'guix-package-info)
:group 'guix-package-info-faces)
(defface guix-package-info-obsolete
'((t :inherit error))
"Face used if a package is obsolete."
:group 'guix-package-info)
:group 'guix-package-info-faces)
(defvar guix-info-insert-package-function
#'guix-package-info-insert-with-heading
@ -541,7 +546,7 @@ Face name is `guix-package-info-TYPE-inputs'."
(defface ,face
'((t :inherit guix-package-info-name-button))
,(concat "Face used for " type-desc "inputs of a package.")
:group 'guix-package-info)
:group 'guix-package-info-faces)
(define-button-type ',btn
:supertype 'guix-package-name
@ -672,7 +677,7 @@ ENTRY is an alist with package info."
(defface guix-package-info-source
'((t :inherit link :underline nil))
"Face used for a source URL of a package."
:group 'guix-package-info)
:group 'guix-package-info-faces)
(defcustom guix-package-info-auto-find-source nil
"If non-nil, find a source file after pressing a \"Show\" button.
@ -825,17 +830,17 @@ If nil, insert output in a default way.")
(defface guix-generation-info-number
'((t :inherit font-lock-keyword-face))
"Face used for a number of a generation."
:group 'guix-generation-info)
:group 'guix-generation-info-faces)
(defface guix-generation-info-current
'((t :inherit guix-package-info-installed-outputs))
"Face used if a generation is the current one."
:group 'guix-generation-info)
:group 'guix-generation-info-faces)
(defface guix-generation-info-not-current
'((t nil))
"Face used if a generation is not the current one."
:group 'guix-generation-info)
:group 'guix-generation-info-faces)
(defvar guix-info-insert-generation-function nil
"Function used to insert a generation information.

11
emacs/guix-list.el
View file

@ -35,10 +35,15 @@
:prefix "guix-list-"
:group 'guix)
(defgroup guix-list-faces nil
"Faces for list buffers."
:group 'guix-list
:group 'guix-faces)
(defface guix-list-file-path
'((t :inherit guix-info-file-path))
"Face used for file paths."
:group 'guix-list)
:group 'guix-list-faces)
(defcustom guix-list-describe-warning-count 10
"The maximum number of entries for describing without a warning.
@ -488,12 +493,12 @@ With prefix (if ARG is non-nil), describe entries marked with any mark."
(defface guix-package-list-installed
'((t :inherit guix-package-info-installed-outputs))
"Face used if there are installed outputs for the current package."
:group 'guix-package-list)
:group 'guix-package-list-faces)
(defface guix-package-list-obsolete
'((t :inherit guix-package-info-obsolete))
"Face used if a package is obsolete."
:group 'guix-package-list)
:group 'guix-package-list-faces)
(defcustom guix-package-list-generation-marking-enabled nil
"If non-nil, allow putting marks in a list with 'generation packages'.

20
emacs/guix-main.scm
View file

@ -71,6 +71,18 @@ (define-syntax-rule (first-or-false lst)
(define (list-maybe obj)
(if (list? obj) obj (list obj)))
(define (output+error thunk)
"Call THUNK and return 2 values: output and error output as strings."
(let ((output-port (open-output-string))
(error-port (open-output-string)))
(with-output-to-port output-port
(lambda () (with-error-to-port error-port thunk)))
(let ((strings (list (get-output-string output-port)
(get-output-string error-port))))
(close-output-port output-port)
(close-output-port error-port)
(apply values strings))))
(define (full-name->name+version spec)
"Given package specification SPEC with or without output,
return two values: name and version. For example, for SPEC
@ -953,9 +965,11 @@ (define (guix-command . args)
(const #t)))
(define (guix-command-output . args)
"Return string with 'guix ARGS ...' output."
(with-output-to-string
(lambda () (apply guix-command args))))
"Return 2 strings with 'guix ARGS ...' output and error output."
(output+error
(lambda ()
(parameterize ((guix-warning-port (current-error-port)))
(apply guix-command args)))))
(define (help-string . commands)
"Return string with 'guix COMMANDS ... --help' output."

11
emacs/guix-prettify.el
View file

@ -77,9 +77,14 @@ disabling `guix-prettify-mode' a little faster."
:group 'guix-prettify)
(defcustom guix-prettify-regexp
(rx "/"
(or "nix" "gnu")
"/store/"
;; The following file names / URLs should be abbreviated:
;; /gnu/store/…-foo-0.1
;; /nix/store/…-foo-0.1
;; http://hydra.gnu.org/nar/…-foo-0.1
;; http://hydra.gnu.org/log/…-foo-0.1
(rx "/" (or "store" "nar" "log") "/"
;; Hash-parts do not include "e", "o", "u" and "t". See base32Chars
;; at <https://github.com/NixOS/nix/blob/master/src/libutil/hash.cc>
(group (= 32 (any "0-9" "a-d" "f-n" "p-s" "v-z"))))

18
emacs/guix-utils.el
View file

@ -208,6 +208,16 @@ single argument."
(funcall guix-find-file-function file)
(message "File '%s' does not exist." file)))
(defvar url-handler-regexp)
(defun guix-find-file-or-url (file-or-url)
"Find FILE-OR-URL."
(require 'url-handlers)
(let ((file-name-handler-alist
(cons (cons url-handler-regexp 'url-file-handler)
file-name-handler-alist)))
(find-file file-or-url)))
(defmacro guix-while-search (regexp &rest body)
"Evaluate BODY after each search for REGEXP in the current buffer."
(declare (indent 1) (debug t))
@ -216,14 +226,6 @@ single argument."
(while (re-search-forward ,regexp nil t)
,@body)))
(defun guix-any (pred lst)
"Test whether any element from LST satisfies PRED.
If so, return the return value from the successful PRED call.
Return nil otherwise."
(when lst
(or (funcall pred (car lst))
(guix-any pred (cdr lst)))))
;;; Alist accessors

5
emacs/guix.el
View file

@ -39,6 +39,11 @@
:prefix "guix-"
:group 'external)
(defgroup guix-faces nil
"Guix faces."
:group 'guix
:group 'faces)
(defcustom guix-list-single-package nil
"If non-nil, list a package even if it is the only matching result.
If nil, show a single package in the info buffer."

2
gnu-system.am
View file

@ -361,6 +361,7 @@ GNU_SYSTEM_MODULES = \
gnu/system/grub.scm \
gnu/system/install.scm \
gnu/system/linux.scm \
gnu/system/linux-container.scm \
gnu/system/linux-initrd.scm \
gnu/system/locale.scm \
gnu/system/nss.scm \
@ -524,6 +525,7 @@ dist_patch_DATA = \
gnu/packages/patches/libbonobo-activation-test-race.patch \
gnu/packages/patches/libcanberra-sound-theme-freedesktop.patch \
gnu/packages/patches/libevent-dns-tests.patch \
gnu/packages/patches/libmtp-devices.patch \
gnu/packages/patches/liboop-mips64-deplibs-fix.patch \
gnu/packages/patches/liblxqt-include.patch \
gnu/packages/patches/libmad-armv7-thumb-pt1.patch \

20
gnu/build/linux-boot.scm
View file

@ -48,7 +48,7 @@ (define-module (gnu build linux-boot)
;;; Code:
(define* (mount-essential-file-systems #:key (root "/"))
"Mount /proc and /sys under ROOT."
"Mount /dev, /proc, and /sys under ROOT."
(define (scope dir)
(string-append root
(if (string-suffix? "/" root)
@ -60,6 +60,10 @@ (define (scope dir)
(mkdir (scope "proc")))
(mount "none" (scope "proc") "proc")
(unless (file-exists? (scope "dev"))
(mkdir (scope "dev")))
(mount "none" (scope "dev") "devtmpfs")
(unless (file-exists? (scope "sys"))
(mkdir (scope "sys")))
(mount "none" (scope "sys") "sysfs"))
@ -71,7 +75,7 @@ (define (move-essential-file-systems root)
(unless (file-exists? target)
(mkdir target))
(mount dir target "" MS_MOVE)))
'("/proc" "/sys")))
'("/dev" "/proc" "/sys")))
(define (linux-command-line)
"Return the Linux kernel command line as a list of strings."
@ -100,7 +104,7 @@ (define* (make-disk-device-nodes base major #:optional (minor 0))
(define* (make-essential-device-nodes #:key (root "/"))
"Make essential device nodes under ROOT/dev."
;; The hand-made udev!
;; The hand-made devtmpfs/udev!
(define (scope dir)
(string-append root
@ -255,7 +259,8 @@ (define (mark-as-not-killable pid)
(mount "none" "/rw-root" "tmpfs")
;; We want read-write /dev nodes.
(make-essential-device-nodes #:root "/rw-root")
(mkdir-p "/rw-root/dev")
(mount "none" "/rw-root/dev" "devtmpfs")
;; Make /root a union of the tmpfs and the actual root. Use
;; 'max_files' to set a high RLIMIT_NOFILE for the unionfs process
@ -385,9 +390,6 @@ (define (lookup-module name)
(unless (configure-qemu-networking)
(display "network interface is DOWN\n")))
;; Make /dev nodes.
(make-essential-device-nodes)
;; Prepare the real root file system under /root.
(unless (file-exists? "/root")
(mkdir "/root"))
@ -405,10 +407,6 @@ (define (lookup-module name)
#:volatile-root? volatile-root?)
(mount "none" "/root" "tmpfs"))
(unless (file-exists? "/root/dev")
(mkdir "/root/dev")
(make-essential-device-nodes #:root "/root"))
;; Mount the specified file systems.
(for-each mount-file-system
(remove root-mount-point? mounts))

15
gnu/packages/abiword.scm
View file

@ -99,8 +99,15 @@ (define-public abiword
("pkg-config" ,pkg-config)))
(home-page "http://abisource.org/")
(synopsis "Word processing program")
(description
"AbiWord is a word processing program. It is rapidly becoming a state
of the art word processor, with lots of features useful for your daily work,
personal needs, or for just some good old typing fun.")
;; HACKERS: The comment below is here so that it shows up early in the
;; .pot file.
;; TRANSLATORS: Dear translator, We would like to inform you that package
;; descriptions may occasionally include Texinfo markup. Texinfo markup
;; looks like "@code{rm -rf}", "@emph{important}", etc. When translating,
;; please leave markup as is.
(description "AbiWord is a word processing program. It is rapidly
becoming a state of the art word processor, with lots of features useful for
your daily work, personal needs, or for just some good old typing fun.")
(license license:gpl2+)))

20
gnu/packages/audio.scm
View file

@ -1052,7 +1052,25 @@ (define-public openal
"0mmhdqiyb3c9dzvxspm8h2v8jibhi8pfjxnf6m0wn744y1ia2a8f"))))
(build-system cmake-build-system)
(arguments
`(#:tests? #f)) ; no check target
`(#:tests? #f ; no check target
#:phases
(modify-phases %standard-phases
(add-after
'unpack 'use-full-library-paths
(lambda* (#:key inputs #:allow-other-keys)
(substitute* "Alc/backends/pulseaudio.c"
(("#define PALIB \"libpulse\\.so\\.0\"")
(string-append "#define PALIB \""
(assoc-ref inputs "pulseaudio")
"/lib/libpulse.so.0"
"\"")))
(substitute* "Alc/backends/alsa.c"
(("LoadLib\\(\"libasound\\.so\\.2\"\\)")
(string-append "LoadLib(\""
(assoc-ref inputs "alsa-lib")
"/lib/libasound.so.2"
"\")")))
#t)))))
(inputs
`(("alsa-lib" ,alsa-lib)
("pulseaudio" ,pulseaudio)))

6
gnu/packages/autogen.scm
View file

@ -30,16 +30,16 @@ (define-module (gnu packages autogen)
(define-public autogen
(package
(name "autogen")
(version "5.18.5")
(version "5.18.6")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://gnu/autogen/rel"
version "/autogen-"
version ".tar.gz"))
version ".tar.xz"))
(sha256
(base32
"1flnbnmkbqmbfgammkl8m36wrlk6rhpgnf9pdm6gdfhqalxvggbv"))))
"0sfmmy19k9z0j3f738fyk6ljf6b66410cvd5zzyplxi2683j10qs"))))
(build-system gnu-build-system)
(native-inputs `(("perl" ,perl) ;for doc generator mdoc
("pkg-config" ,pkg-config)))

29
gnu/packages/base.scm
View file

@ -52,22 +52,23 @@ (define-module (gnu packages base)
(define-public hello
(package
(name "hello")
(version "2.10")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/hello/hello-" version
".tar.gz"))
(sha256
(base32 "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i"))))
(build-system gnu-build-system)
(synopsis "Hello, GNU world: An example GNU package")
(description
"GNU Hello prints the message \"Hello, world!\" and then exits. It
(name "hello")
(version "2.10")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/hello/hello-" version
".tar.gz"))
(sha256
(base32
"0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i"))))
(build-system gnu-build-system)
(synopsis "Hello, GNU world: An example GNU package")
(description
"GNU Hello prints the message \"Hello, world!\" and then exits. It
serves as an example of standard GNU coding practices. As such, it supports
command-line arguments, multiple languages, and so on.")
(home-page "http://www.gnu.org/software/hello/")
(license gpl3+)))
(home-page "http://www.gnu.org/software/hello/")
(license gpl3+)))
(define-public grep
(package

155
gnu/packages/bioinformatics.scm
View file

@ -1,6 +1,8 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2015 Ben Woodcroft <donttrustben@gmail.com>
;;; Copyright © 2015 Pjotr Prins <pjotr.guix@thebird.nl>
;;; Copyright © 2015 Andreas Enge <andreas@enge.fr>
;;;
;;; This file is part of GNU Guix.
;;;
@ -27,6 +29,8 @@ (define-module (gnu packages bioinformatics)
#:use-module (guix build-system cmake)
#:use-module (guix build-system perl)
#:use-module (guix build-system python)
#:use-module (guix build-system r)
#:use-module (guix build-system ruby)
#:use-module (guix build-system trivial)
#:use-module (gnu packages)
#:use-module (gnu packages algebra)
@ -45,6 +49,7 @@ (define-module (gnu packages bioinformatics)
#:use-module (gnu packages popt)
#:use-module (gnu packages protobuf)
#:use-module (gnu packages python)
#:use-module (gnu packages ruby)
#:use-module (gnu packages statistics)
#:use-module (gnu packages tbb)
#:use-module (gnu packages textutils)
@ -1539,6 +1544,64 @@ (define-public macs
sequencing tag position and orientation.")
(license license:bsd-3)))
(define-public mafft
(package
(name "mafft")
(version "7.221")
(source (origin
(method url-fetch)
(uri (string-append
"http://mafft.cbrc.jp/alignment/software/mafft-" version
"-without-extensions-src.tgz"))
(file-name (string-append name "-" version ".tgz"))
(sha256
(base32
"0xi7klbsgi049vsrk6jiwh9wfj3b770gz3c8c7zwij448v0dr73d"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; no automated tests, though there are tests in the read me
#:make-flags (let ((out (assoc-ref %outputs "out")))
(list (string-append "PREFIX=" out)
(string-append "BINDIR="
(string-append out "/bin"))))
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'enter-dir
(lambda _ (chdir "core") #t))
(add-after 'enter-dir 'patch-makefile
(lambda _
;; on advice from the MAFFT authors, there is no need to
;; distribute mafft-profile, mafft-distance, or
;; mafft-homologs.rb as they are too "specialised".
(substitute* "Makefile"
;; remove mafft-homologs.rb from SCRIPTS
(("^SCRIPTS = mafft mafft-homologs.rb")
"SCRIPTS = mafft")
;; remove mafft-distance from PROGS
(("^PROGS = dvtditr dndfast7 dndblast sextet5 mafft-distance")
"PROGS = dvtditr dndfast7 dndblast sextet5")
;; remove mafft-profile from PROGS
(("splittbfast disttbfast tbfast mafft-profile 2cl mccaskillwrap")
"splittbfast disttbfast tbfast f2cl mccaskillwrap")
(("^rm -f mafft-profile mafft-profile.exe") "#")
(("^rm -f mafft-distance mafft-distance.exe") ")#")
;; do not install MAN pages in libexec folder
(("^\t\\$\\(INSTALL\\) -m 644 \\$\\(MANPAGES\\) \
\\$\\(DESTDIR\\)\\$\\(LIBDIR\\)") "#"))
#t))
(delete 'configure))))
(inputs
`(("perl" ,perl)))
(home-page "http://mafft.cbrc.jp/alignment/software/")
(synopsis "Multiple sequence alignment program")
(description
"MAFFT offers a range of multiple alignment methods for nucleotide and
protein sequences. For instance, it offers L-INS-i (accurate; for alignment
of <~200 sequences) and FFT-NS-2 (fast; for alignment of <~30,000
sequences).")
(license (license:non-copyleft
"http://mafft.cbrc.jp/alignment/software/license.txt"
"BSD-3 with different formatting"))))
(define-public metabat
(package
@ -2607,3 +2670,95 @@ (define-public vcftools
;; The license is declared as LGPLv3 in the README and
;; at http://vcftools.sourceforge.net/license.html
(license license:lgpl3)))
(define-public bio-locus
(package
(name "bio-locus")
(version "0.0.7")
(source
(origin
(method url-fetch)
(uri (rubygems-uri "bio-locus" version))
(sha256
(base32
"02vmrxyimkj9sahsp4zhfhnmbvz6dbbqz1y01vglf8cbwvkajfl0"))))
(build-system ruby-build-system)
(native-inputs
`(("ruby-rspec" ,ruby-rspec)))
(synopsis "Tool for fast querying of genome locations")
(description
"Bio-locus is a tabix-like tool for fast querying of genome
locations. Many file formats in bioinformatics contain records that
start with a chromosome name and a position for a SNP, or a start-end
position for indels. Bio-locus allows users to store this chr+pos or
chr+pos+alt information in a database.")
(home-page "https://github.com/pjotrp/bio-locus")
(license license:expat)))
(define-public bioruby
(package
(name "bioruby")
(version "1.5.0")
(source
(origin
(method url-fetch)
(uri (rubygems-uri "bio" version))
(sha256
(base32
"01k2fyjl5fpx4zn8g6gqiqvsg2j1fgixrs9p03vzxckynxdq3wmc"))))
(build-system ruby-build-system)
(propagated-inputs
`(("ruby-libxml" ,ruby-libxml)))
(native-inputs
`(("which" ,which))) ; required for test phase
(arguments
`(#:phases
(modify-phases %standard-phases
(add-before 'build 'patch-test-command
(lambda _
(substitute* '("test/functional/bio/test_command.rb")
(("/bin/sh") (which "sh")))
(substitute* '("test/functional/bio/test_command.rb")
(("/bin/ls") (which "ls")))
(substitute* '("test/functional/bio/test_command.rb")
(("which") (which "which")))
(substitute* '("test/functional/bio/test_command.rb",
"test/data/command/echoarg2.sh")
(("/bin/echo") (which "echo")))
#t)))))
(synopsis "Ruby library, shell and utilities for bioinformatics")
(description "BioRuby comes with a comprehensive set of Ruby development
tools and libraries for bioinformatics and molecular biology. BioRuby has
components for sequence analysis, pathway analysis, protein modelling and
phylogenetic analysis; it supports many widely used data formats and provides
easy access to databases, external programs and public web services, including
BLAST, KEGG, GenBank, MEDLINE and GO.")
(home-page "http://bioruby.org/")
;; Code is released under Ruby license, except for setup
;; (LGPLv2.1+) and scripts in samples (which have GPL2 and GPL2+)
(license (list license:ruby license:lgpl2.1+ license:gpl2+ ))))
(define-public r-qtl
(package
(name "r-qtl")
(version "1.37-11")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://cran/src/contrib/qtl_"
version ".tar.gz"))
(sha256
(base32
"0h20d36mww7ljp51pfs66xq33yq4b4fwq9nsh02dpmfhlaxgx1xi"))))
(build-system r-build-system)
(home-page "http://rqtl.org/")
(synopsis "R package for analyzing QTL experiments in genetics")
(description "R/qtl is an extension library for the R statistics
system. It is used to analyze experimental crosses for identifying
genes contributing to variation in quantitative traits (so-called
quantitative trait loci, QTLs).
Using a hidden Markov model, R/qtl allows to estimate genetic maps, to
identify genotyping errors, and to perform single-QTL and two-QTL,
two-dimensional genome scans.")
(license license:gpl3)))

14
gnu/packages/compression.scm
View file

@ -357,17 +357,15 @@ (define-public sharutils
(define-public sfarklib
(package
(name "sfarklib")
(version "2.23.5ca96b779")
(version "2.24")
(source (origin
;; The 2.23 tarball does not include the Makefile, but only
;; Makefile.am.
(method git-fetch)
(uri (git-reference
(url "https://github.com/raboof/sfArkLib.git")
(commit (last (string-split version #\.)))))
(method url-fetch)
(uri (string-append "https://github.com/raboof/sfArkLib/archive/"
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1hk1x88dl5b9jq016r6rx5wyszxknyv0sa7gmil4m4alnhwl4h7h"))))
"0bzs2d98rk1xw9qwpnc7gmlbxwmwc3dg1rpn310afy9pq1k9clzi"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ;no "check" target

3
gnu/packages/databases.scm
View file

@ -289,7 +289,8 @@ (define-public recutils
(arguments '(#:parallel-tests? #f))
(native-inputs `(("emacs" ,emacs-no-x)
("bc" ,bc)))
("bc" ,bc)
("libuuid", util-linux)))
;; TODO: Add more optional inputs.
;; FIXME: Our Bash doesn't have development headers (need for the 'readrec'

74
gnu/packages/emacs.scm
View file

@ -1092,3 +1092,77 @@ (define-public emacs-debbugs
A minor mode @code{debbugs-browse-mode} let you browse URLs to the GNU Bug
Tracker as well as bug identifiers prepared for @code{bug-reference-mode}.")
(license license:gpl3+)))
(define-public emacs-deferred
(package
(name "emacs-deferred")
(version "0.3.2")
(home-page "https://github.com/kiwanami/emacs-deferred")
(source (origin
(method git-fetch)
(uri (git-reference
(url home-page)
(commit (string-append "v" version))))
(sha256
(base32
"0059jy01ni5irpgrj9fa81ayd9j25nvmjjm79ms3210ysx4pgqdr"))
(file-name (string-append name "-" version))))
(build-system emacs-build-system)
;; FIXME: Would need 'el-expectations' to actually run tests.
(synopsis "Simple asynchronous functions for Emacs Lisp")
(description
"The @code{deferred.el} library provides support for asynchronous tasks.
The API is almost the same as that of
@uref{https://github.com/cho45/jsdeferred, JSDeferred}, a JavaScript library
for asynchronous tasks.")
(license license:gpl3+)))
(define-public butler
(package
(name "emacs-butler")
(version "0.2.4")
(home-page "https://github.com/AshtonKem/Butler")
(source (origin
(method git-fetch)
(uri (git-reference
(url home-page)
(commit version)))
(sha256
(base32
"1pii9dw4skq7nr4na6qxqasl36av8cwjp71bf1fgppqpcd9z8skj"))
(file-name (string-append name "-" version))))
(build-system emacs-build-system)
(propagated-inputs
`(("emacs-deferred" ,emacs-deferred)))
(synopsis "Emacs client for Jenkins")
(description
"Butler provides an interface to connect to Jenkins continuous
integration servers. Users can specify a list of server in the
@code{butler-server-list} variable and then use @code{M-x butler-status} to
view the build status of those servers' build jobs, and possibly to trigger
build jobs.")
(license license:gpl3+)))
(define-public typo
(package
(name "emacs-typo")
(version "1.1")
(home-page "https://github.com/jorgenschaefer/typoel")
(source (origin
(method git-fetch)
(uri (git-reference
(url home-page)
(commit (string-append "v" version))))
(sha256
(base32
"1jhd4grch5iz12gyxwfbsgh4dmz5hj4bg4gnvphccg8dsnni05k2"))
(file-name (string-append name "-" version))))
(build-system emacs-build-system)
(synopsis "Minor mode for typographic editing")
(description
"This package provides two Emacs modes, @code{typo-mode} and
@code{typo-global-mode}. These modes automatically insert Unicode characters
for quotation marks, dashes, and ellipses. For example, typing @kbd{\"}
automatically inserts a Unicode opening or closing quotation mark, depending
on context.")
(license license:gpl3+)))

14
gnu/packages/game-development.scm
View file

@ -102,19 +102,21 @@ (define-public tiled
(define-public sfml
(package
(name "sfml")
(version "2.3.1")
(version "2.3.2")
(source (origin
(method url-fetch)
(uri (string-append "http://mirror0.sfml-dev.org/files/SFML-"
version "-sources.zip"))
;; Do not fetch the archives from
;; http://mirror0.sfml-dev.org/files/ because files there seem
;; to be changed in place.
(uri (string-append "https://github.com/SFML/SFML/archive/"
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"0mjpkgfnz6ka4p0ir219pcqsbdy7gwcjydk7xxmjjfm2k5sw2qys"))))
"0k2fl5xk3ni2q8bsxl0551inx26ww3w6cp6hssvww0wfjdjcirsm"))))
(build-system cmake-build-system)
(arguments
'(#:tests? #f)) ; no tests
(native-inputs
`(("unzip" ,unzip)))
(inputs
`(("mesa" ,mesa)
("glew" ,glew)

125
gnu/packages/gnome.scm
View file

@ -44,6 +44,7 @@ (define-module (gnu packages gnome)
#:use-module (gnu packages djvu)
#:use-module (gnu packages flex)
#:use-module (gnu packages docbook)
#:use-module (gnu packages gettext)
#:use-module (gnu packages glib)
#:use-module (gnu packages gnupg)
#:use-module (gnu packages gnuzilla)
@ -60,6 +61,7 @@ (define-module (gnu packages gnome)
#:use-module (gnu packages libusb)
#:use-module (gnu packages lirc)
#:use-module (gnu packages lua)
#:use-module (gnu packages m4)
#:use-module (gnu packages image)
#:use-module (gnu packages perl)
#:use-module (gnu packages photo)
@ -69,6 +71,7 @@ (define-module (gnu packages gnome)
#:use-module (gnu packages scanner)
#:use-module (gnu packages ssh)
#:use-module (gnu packages xml)
#:use-module (gnu packages geeqie)
#:use-module (gnu packages gl)
#:use-module (gnu packages qt) ; for libxkbcommon
#:use-module (gnu packages compression)
@ -3500,3 +3503,125 @@ (define-public yelp-tools
lifting is done by packages like yelp-xsl and itstool. This package just
wraps things up in a developer-friendly way.")
(license license:gpl2+)))
(define-public libgee
(package
(name "libgee")
(version "0.18.0")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnome/sources/" name "/"
(version-major+minor version) "/"
name "-" version ".tar.xz"))
(sha256
(base32
"16a34js81w9m2bw4qd8csm4pcgr3zq5z87867j4b8wfh6zwrxnaa"))))
(build-system gnu-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'fix-introspection-install-dir
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(substitute* "gee/Makefile.in"
(("@INTROSPECTION_GIRDIR@")
(string-append out "/share/gir-1.0/"))
(("@INTROSPECTION_TYPELIBDIR@")
(string-append out "/lib/girepository-1.0/")))))))))
(native-inputs
`(("glib" ,glib "bin")
("pkg-config" ,pkg-config)))
(inputs
`(("glib" ,glib)
("gobject-introspection" ,gobject-introspection)))
(home-page "https://wiki.gnome.org/Projects/Libgee")
(synopsis "GObject collection library")
(description
"Libgee is a utility library providing GObject-based interfaces and
classes for commonly used data structures.")
(license license:lgpl2.1+)))
(define-public gexiv2
(package
(name "gexiv2")
(version "0.10.3")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnome/sources/" name "/"
(version-major+minor version) "/"
name "-" version ".tar.xz"))
(sha256
(base32
"121r5lv6l82pjr0ycdf2b01mdwy7sxwca2r068zrzylpc6bgn31r"))))
(build-system gnu-build-system)
(native-inputs
`(("glib" ,glib "bin")
("pkg-config" ,pkg-config)))
(propagated-inputs
;; Listed in "Requires" section of gexiv2.pc
`(("exiv2" ,exiv2)))
(inputs
`(("glib" ,glib)
("gobject-introspection" ,gobject-introspection)))
(home-page "https://wiki.gnome.org/Projects/gexiv2")
(synopsis "GObject wrapper around the Exiv2 photo metadata library")
(description
"Gexiv2 is a GObject wrapper around the Exiv2 photo metadata library. It
allows for GNOME applications to easily inspect and update EXIF, IPTC, and XMP
metadata in photo and video files of various formats.")
(license license:gpl2+)))
(define-public shotwell
(package
(name "shotwell")
(version "0.22.0")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnome/sources/" name "/"
(version-major+minor version) "/"
name "-" version ".tar.xz"))
(sha256
(base32
"0cgqaaikrb10plhf6zxbgqy32zqpiwyi9dpx3g8yr261q72r5c81"))))
(build-system glib-or-gtk-build-system)
(arguments
`(#:tests? #f ;no "check" target
#:make-flags '("CC=gcc")
#:configure-flags '("--disable-gsettings-convert-install")
#:out-of-source? #f))
(native-inputs
`(("pkg-config" ,pkg-config)
("gettext" ,gnu-gettext)
("m4" ,m4)
("desktop-file-utils" ,desktop-file-utils)
("vala" ,vala)
("which" ,which)
("gnome-doc-utils" ,gnome-doc-utils)
;; FIXME: I only added python2-libxml2 because xml2po needs it at
;; runtime. It should be propagated.
("python2-libxml2" ,python2-libxml2)
("python2" ,python-2)))
(inputs
`(("gstreamer" ,gstreamer)
("gst-plugins-base" ,gst-plugins-base)
("gst-plugins-good" ,gst-plugins-good)
("libgee" ,libgee)
("gexiv2" ,gexiv2)
("libraw" ,libraw)
("json-glib" ,json-glib)
("rest" ,rest)
("webkitgtk" ,webkitgtk-2.4)
("sqlite" ,sqlite)
("libsoup" ,libsoup)
("libxml2" ,libxml2)
("gtk+" ,gtk+)
("libgudev" ,libgudev)
("libgphoto2" ,libgphoto2)))
(home-page "https://wiki.gnome.org/Apps/Shotwell")
(synopsis "Photo manager for GNOME 3")
(description
"Shotwell is a digital photo manager designed for the GNOME desktop
environment. It allows you to import photos from disk or camera, organize
them by keywords and events, view them in full-window or fullscreen mode, and
share them with others via social networking and more.")
(license license:lgpl2.1+)))

4
gnu/packages/gnu-pw-mgr.scm
View file

@ -29,7 +29,7 @@ (define-module (gnu packages gnu-pw-mgr)
(define-public gnu-pw-mgr
(package
(name "gnu-pw-mgr")
(version "1.4")
(version "1.5")
(source
(origin
(method url-fetch)
@ -37,7 +37,7 @@ (define-public gnu-pw-mgr
version ".tar.xz"))
(sha256
(base32
"0a352y1m33vp6zmdbn96fdrq9gr9lchc9vcrj14mfx7g0dsvxjns"))))
"1winmckl4h8lypg57hd3nd7jscpdr7f1v8zi432k5h648izkf2dg"))))
(build-system gnu-build-system)
(native-inputs
`(("which" ,which)

27
gnu/packages/guile.scm
View file

@ -185,18 +185,19 @@ (define-public guile-2.0/fixed
;; in the `base' module, and thus changing it entails a full rebuild.
guile-2.0)
(define-public guile-for-guile-emacs
(define-public guile-next
(package (inherit guile-2.0)
(name "guile-for-guile-emacs")
(version "20150510.d8d9a8d")
(name "guile-next")
(version "20150815.00884bb")
(source (origin
(method git-fetch)
(uri (git-reference
(url "git://git.hcoop.net/git/bpt/guile.git")
(commit "d8d9a8da05ec876acba81a559798eb5eeceb5a17")))
(url "git://git.sv.gnu.org/guile.git")
(commit "00884bb79fff41fdf5f22f24a74e366a94a14c9b")))
(sha256
(base32
"00sprsshy16y8pxjy126hr2adqcvvzzz96hjyjwgg8swva1qh6b0"))))
"0qk8m9aq3i7pzw6npim58xmsvjqfz5kl1pkyb6b43awn2vydydi5"))))
(arguments
(substitute-keyword-arguments `(;; Tests aren't passing for now.
;; Obviously we should re-enable this!
@ -212,6 +213,7 @@ (define-public guile-for-guile-emacs
(substitute* "build-aux/git-version-gen"
(("#!/bin/sh") (string-append "#!" (which "sh"))))
#t))))))
(synopsis "Snapshot of what will become version 2.2 of GNU Guile")
(native-inputs
`(("autoconf" ,autoconf)
("automake" ,automake)
@ -221,6 +223,19 @@ (define-public guile-for-guile-emacs
("gettext" ,gnu-gettext)
,@(package-native-inputs guile-2.0)))))
(define-public guile-for-guile-emacs
(package (inherit guile-next)
(name "guile-for-guile-emacs")
(version "20150510.d8d9a8d")
(source (origin
(method git-fetch)
(uri (git-reference
(url "git://git.hcoop.net/git/bpt/guile.git")
(commit "d8d9a8da05ec876acba81a559798eb5eeceb5a17")))
(sha256
(base32
"00sprsshy16y8pxjy126hr2adqcvvzzz96hjyjwgg8swva1qh6b0"))))))
;;;
;;; Extensions.

3
gnu/packages/libusb.scm
View file

@ -96,7 +96,8 @@ (define-public libmtp
"/libmtp-" version ".tar.gz"))
(sha256
(base32
"12dinqic0ljnhrwx3rc61jc7q24ybr0mckc2ya5kh1s1np0d7w93"))))
"12dinqic0ljnhrwx3rc61jc7q24ybr0mckc2ya5kh1s1np0d7w93"))
(patches (list (search-patch "libmtp-devices.patch")))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)))

4
gnu/packages/linux.scm
View file

@ -210,7 +210,7 @@ (define (lookup file)
#f)))
(define-public linux-libre
(let* ((version "4.2")
(let* ((version "4.2.1")
(build-phase
'(lambda* (#:key system inputs #:allow-other-keys #:rest args)
;; Apply the neat patch.
@ -283,7 +283,7 @@ (define-public linux-libre
(uri (linux-libre-urls version))
(sha256
(base32
"0jfgbr9qc92bk7hyfdvw030xyic2bg834l8cxp25rw9qbbdck3rs"))))
"140cqnk1hyhavfra572wwzwz7pddczc78j8anbxyciw35kh8z2hl"))))
(build-system gnu-build-system)
(native-inputs `(("perl" ,perl)
("bc" ,bc)

14
gnu/packages/music.scm
View file

@ -187,7 +187,7 @@ (define-public klick
(define-public lilypond
(package
(name "lilypond")
(version "2.18.2")
(version "2.19.27")
(source (origin
(method url-fetch)
(uri (string-append
@ -196,14 +196,15 @@ (define-public lilypond
name "-" version ".tar.gz"))
(sha256
(base32
"01xs9x2wjj7w9appaaqdhk15r1xvvdbz9qwahzhppfmhclvp779j"))))
"11v4jr4qj1jpqvjw1ww7riv8pxfyasif8mf16l447f1xq1ifhkhs"))))
(build-system gnu-build-system)
(arguments
`(;; Tests fail with this error:
;; Undefined subroutine &main::get_index called at
;; ./lilypond-2.18.2/Documentation/lilypond-texi2html.init line 2127.
#:tests? #f
`(#:tests? #f ; out-test/collated-files.html fails
#:out-of-source? #t
#:configure-flags
(list (string-append "--with-texgyre-dir="
(assoc-ref %build-inputs "font-tex-gyre")
"/share/fonts/opentype/"))
#:phases
(alist-cons-before
'configure 'prepare-configuration
@ -216,6 +217,7 @@ (define-public lilypond
(inputs
`(("guile" ,guile-1.8)
("font-dejavu" ,font-dejavu)
("font-tex-gyre" ,font-tex-gyre)
("fontconfig" ,fontconfig)
("freetype" ,freetype)
("ghostscript" ,ghostscript)

43
gnu/packages/networking.scm
View file

@ -2,6 +2,7 @@
;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015 Stefan Reichör <stefan@xsteve.at>
;;;
;;; This file is part of GNU Guix.
;;;
@ -23,7 +24,8 @@ (define-module (gnu packages networking)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (gnu packages tls))
#:use-module (gnu packages tls)
#:use-module (gnu packages ncurses))
(define-public miredo
(package
@ -146,3 +148,42 @@ (define-public ethtool
auto-negotiation and checksum offload on many network devices, especially
Ethernet devices.")
(license license:gpl2)))
(define-public ifstatus
(package
(name "ifstatus")
(version "1.1.0")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/ifstatus/ifstatus-v"
version ".tar.gz"))
(sha256
(base32
"045cbsq9ps32j24v8y5hpyqxnqn9mpaf3mgvirlhgpqyb9jsia0c"))
(modules '((guix build utils)))
(snippet
'(substitute* "Main.h"
(("#include <stdio.h>")
"#include <stdio.h>\n#include <stdlib.h>")))))
(build-system gnu-build-system)
(arguments
'(#:tests? #f ; no "check" target
#:phases
(modify-phases %standard-phases
(delete 'configure) ; no configure script
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin")))
(mkdir-p bin)
(copy-file "ifstatus"
(string-append bin "/ifstatus"))))))))
(inputs `(("ncurses" ,ncurses)))
(home-page "http://ifstatus.sourceforge.net/graphic/index.html")
(synopsis "Text based network interface status monitor")
(description
"IFStatus is a simple, easy-to-use program for displaying commonly
needed/wanted real-time traffic statistics of multiple network
interfaces, with a simple and efficient view on the command line. It is
intended as a substitute for the PPPStatus and EthStatus projects.")
(license license:gpl2+)))

263
gnu/packages/openstack.scm
View file

@ -25,6 +25,41 @@ (define-module (gnu packages openstack)
#:select (asl2.0))
#:use-module (guix packages))
(define-public python-debtcollector
(package
(name "python-debtcollector")
(version "0.5.0")
(source
(origin
(method url-fetch)
(uri (string-append
"https://pypi.python.org/packages/source/d/debtcollector/"
"debtcollector-" version ".tar.gz"))
(sha256
(base32
"0amlcg5f98lk2mfzdg44slh1nsi2y4ds123g5d57376fjk2b3njd"))))
(build-system python-build-system)
(propagated-inputs
`(("python-six" ,python-six)
("python-wrapt" ,python-wrapt)))
(inputs
`(("python-babel" ,python-babel)
("python-pbr" ,python-pbr)
("python-setuptools" ,python-setuptools)
;; Tests.
("python-oslotest" ,python-oslotest)))
(home-page "http://www.openstack.org/")
(synopsis
"Find deprecated patterns and strategies in Python code")
(description
"This package provides a collection of Python deprecation patterns and
strategies that help you collect your technical debt in a non-destructive
manner.")
(license asl2.0)))
(define-public python2-debtcollector
(package-with-python2 python-debtcollector))
(define-public python-mox3
(package
(name "python-mox3")
@ -139,7 +174,147 @@ (define-public python-pbr
(define-public python2-pbr
(package-with-python2 python-pbr))
(define-public python-requests-mock
(package
(name "python-requests-mock")
(version "0.6.0")
(source
(origin
(method url-fetch)
(uri (string-append
"https://pypi.python.org/packages/source/r/requests-mock/"
"requests-mock-" version ".tar.gz"))
(sha256
(base32
"0gmd88c224y53b1ai8cfsrcxm9kw3gdqzysclmnaqspg7zjhxwd1"))))
(build-system python-build-system)
(propagated-inputs
`(("python-requests" ,python-requests)
("python-six" ,python-six)))
(inputs
`(("python-mock" ,python-mock)
("python-pbr" ,python-pbr)
("python-setuptools" ,python-setuptools)))
(home-page "https://requests-mock.readthedocs.org/")
(synopsis "Mock out responses from the requests package")
(description
"This module provides a building block to stub out the HTTP requests
portions of your testing code.")
(license asl2.0)))
(define-public python2-requests-mock
(package-with-python2 python-requests-mock))
(define-public python-stevedore
(package
(name "python-stevedore")
(version "1.7.0")
(source
(origin
(method url-fetch)
(uri (string-append
"https://pypi.python.org/packages/source/s/stevedore/stevedore-"
version
".tar.gz"))
(sha256
(base32
"149pjc0c3z6khjisn4yil3f94qjnzwafz093wc8rrzbw828qdkv8"))))
(build-system python-build-system)
(propagated-inputs
`(("python-six" ,python-six)))
(inputs
`(("python-pbr" ,python-pbr)
("python-setuptools" ,python-setuptools)
;; Tests
("python-docutils" ,python-docutils)
("python-mock" ,python-mock)
("python-oslotest" ,python-oslotest)
("python-sphinx" ,python-sphinx)))
(home-page "https://github.com/dreamhost/stevedore")
(synopsis "Manage dynamic plugins for Python applications")
(description
"Python makes loading code dynamically easy, allowing you to configure
and extend your application by discovering and loading extensions (“plugins”)
at runtime. Many applications implement their own library for doing this,
using __import__ or importlib. stevedore avoids creating yet another extension
mechanism by building on top of setuptools entry points. The code for managing
entry points tends to be repetitive, though, so stevedore provides manager
classes for implementing common patterns for using dynamically loaded
extensions.")
(license asl2.0)))
(define-public python2-stevedore
(package-with-python2 python-stevedore))
;; Packages from the Oslo library
(define-public python-oslo.config
(package
(name "python-oslo.config")
(version "2.4.0")
(source
(origin
(method url-fetch)
(uri (string-append
"https://pypi.python.org/packages/source/o/oslo.config/oslo.config-"
version
".tar.gz"))
(sha256
(base32
"13r778jfb0fhna37c2pd1f2xipnsbd7zli7qhn96acrzymrwj5k1"))))
(build-system python-build-system)
(propagated-inputs
`(("python-netaddr" ,python-netaddr)
("python-six" ,python-six)
("python-stevedore" ,python-stevedore)))
(inputs
`(("python-pbr" ,python-pbr)
("python-setuptools" ,python-setuptools)
;; Tests
("python-oslo.i18n" ,python-oslo.i18n)
("python-mock" ,python-mock)
("python-oslotest" ,python-oslotest)
("python-testscenarios" ,python-testscenarios)))
(home-page "https://launchpad.net/oslo")
(synopsis "Oslo Configuration API")
(description
"The Oslo configuration API supports parsing command line arguments and
.ini style configuration files.")
(license asl2.0)))
(define-public python2-oslo.config
(package-with-python2 python-oslo.config))
(define-public python-oslo.context
(package
(name "python-oslo.context")
(version "0.6.0")
(source
(origin
(method url-fetch)
(uri (string-append
"https://pypi.python.org/packages/source/o/oslo.context/"
"oslo.context-" version ".tar.gz"))
(sha256
(base32
"16wr9qrkc3lb94ssb14qid4liza66x316fvzjw0izg67h1a0fm86"))))
(build-system python-build-system)
(inputs
`(("python-babel" ,python-babel)
("python-pbr" ,python-pbr)
("python-setuptools" ,python-setuptools)
;; Tests.
("python-oslotest" ,python-oslotest)))
(home-page "http://launchpad.net/oslo")
(synopsis "Oslo context library")
(description
"The Oslo context library has helpers to maintain useful information
about a request context. The request context is usually populated in the WSGI
pipeline and used by various modules such as logging.")
(license asl2.0)))
(define-public python2-oslo.context
(package-with-python2 python-oslo.context))
(define-public python-oslo.i18n
(package
(name "python-oslo.i18n")
@ -177,6 +352,45 @@ (define-public python-oslo.i18n
(define-public python2-oslo.i18n
(package-with-python2 python-oslo.i18n))
(define-public python-oslo.serialization
(package
(name "python-oslo.serialization")
(version "1.9.0")
(source
(origin
(method url-fetch)
(uri (string-append
"https://pypi.python.org/packages/source/o/oslo.serialization/"
"oslo.serialization-" version ".tar.gz"))
(sha256
(base32
"00qaxg155s61ylh4fqc7m5fh0gijf33khhai9xvcsc9k106i3c9c"))))
(build-system python-build-system)
(propagated-inputs
`(("python-iso8601" ,python-iso8601)
("python-netaddr" ,python-netaddr)
("python-oslo.utils" ,python-oslo.utils)
("python-simplejson" ,python-simplejson)
("python-six" ,python-six)
("python-pytz" ,python-pytz)))
(inputs
`(("python-babel" ,python-babel)
("python-pbr" ,python-pbr)
("python-setuptools" ,python-setuptools)
;; Tests.
("python-mock" ,python-mock)
("python-oslo.i18n" ,python-oslo.i18n)
("python-oslotest" ,python-oslotest)))
(home-page "http://launchpad.net/oslo")
(synopsis "Oslo serialization library")
(description
"The oslo.serialization library provides support for representing objects
in transmittable and storable formats, such as JSON and MessagePack.")
(license asl2.0)))
(define-public python2-oslo.serialization
(package-with-python2 python-oslo.serialization))
(define-public python-oslotest
(package
(name "python-oslotest")
@ -214,3 +428,52 @@ (define-public python-oslotest
(define-public python2-oslotest
(package-with-python2 python-oslotest))
(define-public python-oslo.utils
(package
(name "python-oslo.utils")
(version "2.5.0")
(source
(origin
(method url-fetch)
(uri (string-append
"https://pypi.python.org/packages/source/o/oslo.utils/oslo.utils-"
version
".tar.gz"))
(sha256
(base32
"11b073gblhzkxhi1j6sqk3apq2ll8xhi9h9g9kxzx9dycqdq0qp0"))
(snippet
'(begin
;; FIXME: setuptools fails to import this file during the test
;; phase.
(delete-file "oslo_utils/tests/test_netutils.py")))))
(build-system python-build-system)
(propagated-inputs
`(("python-debtcollector" ,python-debtcollector)
("python-oslo.i18n" ,python-oslo.i18n)
("python-iso8601" ,python-iso8601)
("python-monotonic" ,python-monotonic)
("python-netaddr" ,python-netaddr)
("python-netifaces" ,python-netifaces)
("python-pytz" ,python-pytz)
("python-six" ,python-six)))
(inputs
`(("python-babel" ,python-babel)
("python-pbr" ,python-pbr)
("python-setuptools" ,python-setuptools)
;; Tests.
("python-oslotest" ,python-oslotest)
("python-mock" ,python-mock)
("python-mox3" ,python-mox3)
("python-testscenarios" ,python-testscenarios)))
(home-page "http://launchpad.net/oslo")
(synopsis "Oslo utility library")
(description
"The @code{oslo.utils} library provides support for common utility type
functions, such as encoding, exception handling, string manipulation, and time
handling.")
(license asl2.0)))
(define-public python2-oslo.utils
(package-with-python2 python-oslo.utils))

37
gnu/packages/password-utils.scm
View file

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Steve Sprang <scs@stevesprang.com>
;;; Copyright © 2015 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
@ -18,9 +19,14 @@
(define-module (gnu packages password-utils)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix build-system cmake)
#:use-module (guix build-system gnu)
#:use-module (guix download)
#:use-module (guix packages))
#:use-module (guix packages)
#:use-module (gnu packages compression)
#:use-module (gnu packages gnupg)
#:use-module (gnu packages qt)
#:use-module (gnu packages xorg))
(define-public pwgen
(package
@ -41,3 +47,32 @@ (define-public pwgen
(description "Pwgen generates passwords which can be easily memorized by a
human.")
(license license:gpl2)))
(define-public keepassx
(package
(name "keepassx")
(version "2.0-beta2")
(source
(origin
(method url-fetch)
(uri (string-append "https://github.com/keepassx/keepassx/archive/"
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32 "0ljf9ws3wh62zd0gyb0vk2qw6pqsmxrlybrfs5mqahf44q92ca2q"))))
(build-system cmake-build-system)
(inputs
`(("libgcrypt" ,libgcrypt)
("libxtst" ,libxtst)
("qt" ,qt-4)))
(native-inputs
`(("zlib" ,zlib)))
(home-page "https://www.keepassx.org")
(synopsis "Password manager")
(description "KeePassX is a password manager or safe which helps you to
manage your passwords in a secure way. You can put all your passwords in one
database, which is locked with one master key or a key-file which can be stored
on an external storage device. The databases are encrypted using the
algorithms AES or Twofish.")
;; Non functional parts use various licences.
(license license:gpl3)))

554
gnu/packages/patches/libmtp-devices.patch Normal file
View file

@ -0,0 +1,554 @@
Add additional devices; the patched file corresponds to git commit 8e471b,
to which one additional device has been added as reported at
http://sourceforge.net/p/libmtp/bugs/1422/
diff -u -r libmtp-1.1.9.orig/src/music-players.h libmtp-1.1.9/src/music-players.h
--- libmtp-1.1.9.orig/src/music-players.h 2015-09-19 22:54:24.537330594 +0200
+++ libmtp-1.1.9/src/music-players.h 2015-09-19 23:16:41.079206331 +0200
@@ -47,82 +47,61 @@
* and properties.
*/
{ "Creative", 0x041e, "ZEN Vision", 0x411f,
- DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL |
- DEVICE_FLAG_BROKEN_GET_OBJECT_PROPVAL },
+ DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL },
{ "Creative", 0x041e, "Portable Media Center", 0x4123,
- DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL |
- DEVICE_FLAG_BROKEN_GET_OBJECT_PROPVAL },
+ DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL },
{ "Creative", 0x041e, "ZEN Xtra (MTP mode)", 0x4128,
- DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL |
- DEVICE_FLAG_BROKEN_GET_OBJECT_PROPVAL },
+ DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL },
{ "Dell", 0x041e, "DJ (2nd generation)", 0x412f,
- DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL |
- DEVICE_FLAG_BROKEN_GET_OBJECT_PROPVAL },
+ DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL },
{ "Creative", 0x041e, "ZEN Micro (MTP mode)", 0x4130,
- DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL |
- DEVICE_FLAG_BROKEN_GET_OBJECT_PROPVAL },
+ DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL },
{ "Creative", 0x041e, "ZEN Touch (MTP mode)", 0x4131,
- DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL |
- DEVICE_FLAG_BROKEN_GET_OBJECT_PROPVAL },
+ DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL },
{ "Dell", 0x041e, "Dell Pocket DJ (MTP mode)", 0x4132,
- DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL |
- DEVICE_FLAG_BROKEN_GET_OBJECT_PROPVAL },
- { "Creative", 0x041e, "ZEN MicroPhoto (alternate version)", 0x4133,
- DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL |
- DEVICE_FLAG_BROKEN_GET_OBJECT_PROPVAL },
+ DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL },
+ { "Creative", 0x041e, "ZEN MicroPhoto (alternate version)", 0x4133,
+ DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL },
{ "Creative", 0x041e, "ZEN Sleek (MTP mode)", 0x4137,
- DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL |
- DEVICE_FLAG_BROKEN_GET_OBJECT_PROPVAL },
+ DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL },
{ "Creative", 0x041e, "ZEN MicroPhoto", 0x413c,
- DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL |
- DEVICE_FLAG_BROKEN_GET_OBJECT_PROPVAL },
+ DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL },
{ "Creative", 0x041e, "ZEN Sleek Photo", 0x413d,
- DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL |
- DEVICE_FLAG_BROKEN_GET_OBJECT_PROPVAL },
+ DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL },
{ "Creative", 0x041e, "ZEN Vision:M", 0x413e,
- DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL |
- DEVICE_FLAG_BROKEN_GET_OBJECT_PROPVAL },
+ DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL },
// Reported by marazm@o2.pl
{ "Creative", 0x041e, "ZEN V", 0x4150,
- DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL |
- DEVICE_FLAG_BROKEN_GET_OBJECT_PROPVAL },
+ DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL },
// Reported by danielw@iinet.net.au
// This version of the Vision:M needs the no release interface flag,
// unclear whether the other version above need it too or not.
{ "Creative", 0x041e, "ZEN Vision:M (DVP-HD0004)", 0x4151,
DEVICE_FLAG_NO_RELEASE_INTERFACE |
- DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL |
- DEVICE_FLAG_BROKEN_GET_OBJECT_PROPVAL },
+ DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL },
// Reported by Darel on the XNJB forums
{ "Creative", 0x041e, "ZEN V Plus", 0x4152,
- DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL |
- DEVICE_FLAG_BROKEN_GET_OBJECT_PROPVAL },
+ DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL },
{ "Creative", 0x041e, "ZEN Vision W", 0x4153,
- DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL |
- DEVICE_FLAG_BROKEN_GET_OBJECT_PROPVAL },
+ DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL },
// Don't add 0x4155: this is a Zen Stone device which is not MTP
// Reported by Paul Kurczaba <paul@kurczaba.com>
{ "Creative", 0x041e, "ZEN", 0x4157,
DEVICE_FLAG_IGNORE_HEADER_ERRORS |
DEVICE_FLAG_BROKEN_SET_SAMPLE_DIMENSIONS |
- DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL |
- DEVICE_FLAG_BROKEN_GET_OBJECT_PROPVAL },
+ DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL },
// Reported by Ringofan <mcroman@users.sourceforge.net>
{ "Creative", 0x041e, "ZEN V 2GB", 0x4158,
- DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL |
- DEVICE_FLAG_BROKEN_GET_OBJECT_PROPVAL },
+ DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL },
// Reported by j norment <stormzen@gmail.com>
{ "Creative", 0x041e, "ZEN Mozaic", 0x4161,
- DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL |
- DEVICE_FLAG_BROKEN_GET_OBJECT_PROPVAL },
+ DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL },
// Reported by Aaron F. Gonzalez <sub_tex@users.sourceforge.net>
{ "Creative", 0x041e, "ZEN X-Fi", 0x4162,
- DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL |
- DEVICE_FLAG_BROKEN_GET_OBJECT_PROPVAL },
+ DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL },
// Reported by farmerstimuli <farmerstimuli@users.sourceforge.net>
{ "Creative", 0x041e, "ZEN X-Fi 3", 0x4169,
- DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL |
- DEVICE_FLAG_BROKEN_GET_OBJECT_PROPVAL },
+ DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST_ALL },
// Reported by Todor Gyumyushev <yodor1@users.sourceforge.net>
{ "ZiiLABS", 0x041e, "Zii EGG", 0x6000,
DEVICE_FLAG_UNLOAD_DRIVER |
@@ -607,8 +586,17 @@
/* https://sourceforge.net/p/libmtp/bugs/1251/ */
{ "Acer", 0x0502, "E39", 0x3643,
DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1369/ */
+ { "Acer", 0x0502, "liquid e700", 0x3644,
+ DEVICE_FLAGS_ANDROID_BUGS },
{ "Acer", 0x0502, "One 7", 0x3657,
DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/support-requests/183/ */
+ { "Acer", 0x0502, "Z200", 0x3683,
+ DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1341/ */
+ { "Acer", 0x0502, "Liquid S56", 0x3725,
+ DEVICE_FLAGS_ANDROID_BUGS },
/*
* SanDisk
@@ -952,6 +940,7 @@
{ "Archos", 0x0e79, "SPOD (MTP mode)", 0x1341, DEVICE_FLAG_UNLOAD_DRIVER },
{ "Archos", 0x0e79, "5S IT (MTP mode)", 0x1351, DEVICE_FLAG_UNLOAD_DRIVER },
{ "Archos", 0x0e79, "5H IT (MTP mode)", 0x1357, DEVICE_FLAG_UNLOAD_DRIVER },
+ { "Archos", 0x0e79, "48 (MTP mode)", 0x1421, DEVICE_FLAGS_ANDROID_BUGS },
{ "Archos", 0x0e79, "Arnova Childpad", 0x1458, DEVICE_FLAGS_ANDROID_BUGS },
{ "Archos", 0x0e79, "Arnova 8c G3", 0x145e, DEVICE_FLAGS_ANDROID_BUGS },
{ "Archos", 0x0e79, "Arnova 10bG3 Tablet", 0x146b, DEVICE_FLAGS_ANDROID_BUGS },
@@ -973,9 +962,17 @@
{ "Archos", 0x0e79, "70it2 (ID 2)", 0x1569, DEVICE_FLAGS_ANDROID_BUGS },
{ "Archos", 0x0e79, "50c", 0x2008, DEVICE_FLAGS_ANDROID_BUGS },
{ "Archos", 0x0e79, "C40", 0x31ab, DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1393/ */
+ { "Archos", 0x0e79, "Phone", 0x31e1, DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1325/ */
+ { "Archos", 0x0e79, "45 Neon", 0x31f3, DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1352/ */
+ { "Archos", 0x0e79, "50 Diamond", 0x3229, DEVICE_FLAGS_ANDROID_BUGS },
{ "Archos", 0x0e79, "101 G4", 0x4002, DEVICE_FLAGS_ANDROID_BUGS },
{ "Archos (for Tesco)", 0x0e79, "Hudl (ID1)", 0x5008, DEVICE_FLAGS_ANDROID_BUGS },
{ "Archos (for Tesco)", 0x0e79, "Hudl (ID2)", 0x5009, DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1404/ */
+ { "Archos", 0x0e79, "AC40DTI", 0x5217, DEVICE_FLAGS_ANDROID_BUGS },
/*
* Dunlop (OEM of EGOMAN ltd?) reported by Nanomad
@@ -1181,6 +1178,10 @@
{ "Qualcomm (for OnePlus)", 0x05c6, "One (MTP+ADB)",
0x6765, DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1377/ */
+ { "Qualcomm (for Xolo)", 0x901b, "Xolo Black (MTP)",
+ 0x9039, DEVICE_FLAGS_ANDROID_BUGS },
+
{ "Qualcomm (for PhiComm)", 0x05c6, "C230w (MTP)",
0x9039, DEVICE_FLAGS_ANDROID_BUGS },
@@ -1221,6 +1222,9 @@
// Reported by Thomas Bretthauer
{ "Fujitsu, Ltd", 0x04c5, "STYLISTIC M532", 0x133b,
DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/feature-requests/137/ */
+ { "Fujitsu, Ltd", 0x04c5, "F02-E", 0x1378,
+ DEVICE_FLAGS_ANDROID_BUGS },
/*
* Palm device userland program named Pocket Tunes
@@ -1247,6 +1251,9 @@
// Reported by anonymous SourceForge user
{ "Medion", 0x066f, "MD8333 (ID2)", 0x8588,
DEVICE_FLAG_UNLOAD_DRIVER | DEVICE_FLAG_BROKEN_MTPGETOBJPROPLIST },
+ /* https://sourceforge.net/p/libmtp/bugs/1359/ */
+ { "Verizon", 0x0408, "Ellipsis 7", 0x3899,
+ DEVICE_FLAGS_ANDROID_BUGS },
// The vendor ID is "Quanta Computer, Inc."
// same as Olivetti Olipad 110
// Guessing on device flags
@@ -1403,6 +1410,9 @@
DEVICE_FLAGS_ANDROID_BUGS },
{ "LG Electronics Inc.", 0x1004, "LG2 Optimus", 0x6225,
DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1386/ */
+ { "LG Electronics Inc.", 0x1004, "LG VS950", 0x622a,
+ DEVICE_FLAGS_ANDROID_BUGS },
{ "LG Electronics Inc.", 0x1004, "LG VS870", 0x6239,
DEVICE_FLAGS_ANDROID_BUGS },
/* https://sourceforge.net/p/libmtp/bugs/992/ */
@@ -1410,6 +1420,8 @@
DEVICE_FLAGS_ANDROID_BUGS },
{ "LG Electronics Inc.", 0x1004, "VK810", 0x6265,
DEVICE_FLAGS_ANDROID_BUGS },
+ { "LG Electronics Inc.", 0x1004, "G3", 0x627f,
+ DEVICE_FLAGS_ANDROID_BUGS },
/* https://sourceforge.net/p/libmtp/support-requests/134/ */
{ "LG Electronics Inc.", 0x1004, "G3 (VS985)", 0x626e,
DEVICE_FLAGS_ANDROID_BUGS },
@@ -1723,8 +1735,12 @@
DEVICE_FLAG_NONE },
{ "SONY", 0x0fce, "Xperia M2 MTP", 0x01aa,
DEVICE_FLAG_NONE },
+ { "SONY", 0x0fce, "Xperia M2 Dual MTP", 0x01ab,
+ DEVICE_FLAG_NONE },
{ "SONY", 0x0fce, "Xperia Z2 MTP", 0x01af,
DEVICE_FLAG_NONE },
+ { "SONY", 0x0fce, "Xperia Z2 Tablet MTP", 0x01b1,
+ DEVICE_FLAGS_ANDROID_BUGS },
{ "SONY", 0x0fce, "Xperia Z Ultra MTP", 0x01b6,
DEVICE_FLAGS_ANDROID_BUGS },
{ "SONY", 0x0fce, "Xperia Z3 MTP", 0x01ba,
@@ -1733,6 +1749,10 @@
DEVICE_FLAG_NONE },
{ "SONY", 0x0fce, "Xperia E3 MTP", 0x01bc,
DEVICE_FLAG_NONE },
+ { "SONY", 0x0fce, "XPeria Z3+ MTP", 0x01c9,
+ DEVICE_FLAG_NONE },
+ { "SONY", 0x0fce, "XPeria E4g MTP", 0x01cb,
+ DEVICE_FLAG_NONE },
/*
@@ -1788,6 +1808,8 @@
DEVICE_FLAG_NONE },
{ "SONY", 0x0fce, "Xperia M MTP+CDROM", 0x419b,
DEVICE_FLAG_NONE },
+ { "SONY", 0x0fce, "Xperia Z Ultra MTP+CDROM (ID3)", 0x419c,
+ DEVICE_FLAG_NONE },
{ "SONY", 0x0fce, "Xperia Z1 MTP+CDROM", 0x419e,
DEVICE_FLAG_NONE },
{ "SONY", 0x0fce, "Xperia C MTP+CDROM", 0x41a3,
@@ -1796,10 +1818,20 @@
DEVICE_FLAG_NONE },
{ "SONY", 0x0fce, "Xperia M2 MTP+CDROM", 0x41aa,
DEVICE_FLAG_NONE },
+ { "SONY", 0x0fce, "Xperia M2 Dual MTP+CDROM", 0x41ab,
+ DEVICE_FLAG_NONE },
{ "SONY", 0x0fce, "Xperia Z2 MTP+CDROM", 0x41af,
DEVICE_FLAG_NONE },
{ "SONY", 0x0fce, "Xperia Z3 MTP+CDROM", 0x41ba,
DEVICE_FLAG_NONE },
+ { "SONY", 0x0fce, "Xperia Z3 Compact MTP+CDROM", 0x41bb,
+ DEVICE_FLAG_NONE },
+ { "SONY", 0x0fce, "Xperia E3 MTP+CDROM", 0x01bc,
+ DEVICE_FLAG_NONE },
+ { "SONY", 0x0fce, "XPeria Z3+ MTP+CDROM", 0x41c9,
+ DEVICE_FLAG_NONE },
+ { "SONY", 0x0fce, "XPeria E4g MTP+CDROM", 0x41cb,
+ DEVICE_FLAG_NONE },
/*
* MTP+ADB personalities of MTP devices (see above)
@@ -1888,6 +1920,8 @@
DEVICE_FLAG_NONE },
{ "SONY", 0x0fce, "Xperia M2 MTP+ADB", 0x51aa,
DEVICE_FLAG_NONE },
+ { "SONY", 0x0fce, "Xperia M2 Dual MTP+ADB", 0x51ab,
+ DEVICE_FLAG_NONE },
{ "SONY", 0x0fce, "Xperia Z2 MTP+ADB", 0x51af,
DEVICE_FLAG_NONE },
{ "SONY", 0x0fce, "Xperia Z Ultra MTP+ADB", 0x51b6,
@@ -1898,6 +1932,10 @@
DEVICE_FLAG_NONE },
{ "SONY", 0x0fce, "Xperia E3 MTP+ADB", 0x51bc,
DEVICE_FLAG_NONE },
+ { "SONY", 0x0fce, "XPeria Z3+ MTP+ADB", 0x51c9,
+ DEVICE_FLAG_NONE },
+ { "SONY", 0x0fce, "XPeria E4g MTP+ADB", 0x51cb,
+ DEVICE_FLAG_NONE },
/*
* MTP+UMS modes
@@ -1936,6 +1974,9 @@
* Motorola
* Assume DEVICE_FLAG_BROKEN_SET_OBJECT_PROPLIST on all of these.
*/
+ /* https://sourceforge.net/p/libmtp/feature-requests/136/ */
+ { "Motorola", 0x22b8, "XT1524 (MTP)", 0x002e,
+ DEVICE_FLAGS_ANDROID_BUGS },
// Reported by David Boyd <tiggrdave@users.sourceforge.net>
{ "Motorola", 0x22b8, "V3m/V750 verizon", 0x2a65,
DEVICE_FLAG_BROKEN_SET_OBJECT_PROPLIST |
@@ -1952,6 +1993,9 @@
DEVICE_FLAGS_ANDROID_BUGS },
{ "Motorola", 0x22b8, "Moto X (XT1058)", 0x2e63,
DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1323/ */
+ { "Motorola", 0x22b8, "Moto X (XT1080)", 0x2e66,
+ DEVICE_FLAGS_ANDROID_BUGS },
{ "Motorola", 0x22b8, "Droid Maxx (XT1080)", 0x2e67,
DEVICE_FLAGS_ANDROID_BUGS },
{ "Motorola", 0x22b8, "Droid Ultra", 0x2e68,
@@ -2345,6 +2389,14 @@
/* https://sourceforge.net/p/libmtp/bugs/1244/ */
{ "Asus", 0x0b05, "MemoPad 8 ME181 CX (MTP)", 0x5561,
DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1406/ */
+ { "Asus", 0x0b05, "Zenfone 2 (MTP)", 0x5600,
+ DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1364/ */
+ { "Asus", 0x0b05, "Z00AD (MTP)", 0x5601,
+ DEVICE_FLAGS_ANDROID_BUGS },
+ { "Asus", 0x0b05, "TX201LA (MTP)", 0x561f,
+ DEVICE_FLAGS_ANDROID_BUGS },
/* https://sourceforge.net/p/libmtp/bugs/1271/ */
{ "Asus", 0x0b05, "ZenFone 4 (MTP)", 0x580f,
DEVICE_FLAGS_ANDROID_BUGS },
@@ -2354,9 +2406,20 @@
/* https://sourceforge.net/p/libmtp/bugs/1258/ */
{ "Asus", 0x0b05, "A450CG (MTP)", 0x5a0f,
DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1350/ */
+ { "Asus", 0x0b05, "Zenfone 2 ZE550ML (MTP)", 0x5f02,
+ DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1364/ */
+ { "Asus", 0x0b05, "Zenfone 2 ZE551ML (MTP)", 0x5f03,
+ DEVICE_FLAGS_ANDROID_BUGS },
/* https://sourceforge.net/p/libmtp/bugs/1232/ */
{ "Asus", 0x0b05, "MemoPad 7 (ME572CL)", 0x7772,
DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1351/ */
+ { "Asus", 0x0b05, "Fonepad 7 (FE375CXG)", 0x7773,
+ DEVICE_FLAGS_ANDROID_BUGS },
+ { "Asus", 0x0b05, "ZenFone 5 A500KL (MTP)", 0x7780,
+ DEVICE_FLAGS_ANDROID_BUGS },
/* https://sourceforge.net/p/libmtp/bugs/1247/ */
{ "Asus", 0x0b05, "ZenFone 5 A500KL (MTP+ADB)", 0x7781,
DEVICE_FLAGS_ANDROID_BUGS },
@@ -2365,6 +2428,12 @@
/*
* Lenovo
*/
+ /* https://sourceforge.net/p/libmtp/support-requests/178/ */
+ { "Lenovo", 0x17ef, "P70-A", 0x0c02,
+ DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1415/ */
+ { "Lenovo", 0x17ef, "P70", 0x2008,
+ DEVICE_FLAGS_ANDROID_BUGS },
// Reported by Richard Körber <shredzone@users.sourceforge.net>
{ "Lenovo", 0x17ef, "K1", 0x740a,
DEVICE_FLAGS_ANDROID_BUGS },
@@ -2407,6 +2476,9 @@
DEVICE_FLAGS_ANDROID_BUGS },
{ "Lenovo", 0x17ef, "Toga Tablet B6000-F", 0x76f2,
DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1122/ */
+ { "Lenovo", 0x17ef, "S930", 0x7718,
+ DEVICE_FLAGS_ANDROID_BUGS },
/* https://sourceforge.net/p/libmtp/bugs/1250/ */
{ "Lenovo", 0x17ef, "A5500-F", 0x772b,
DEVICE_FLAGS_ANDROID_BUGS },
@@ -2417,15 +2489,24 @@
/* https://sourceforge.net/p/libmtp/bugs/1155/ */
{ "Lenovo", 0x17ef, "Yoga Tablet 10 B8000-H", 0x76ff,
DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1391/ */
+ { "Lenovo", 0x17ef, "A7600-F", 0x7731,
+ DEVICE_FLAGS_ANDROID_BUGS },
/* https://sourceforge.net/p/libmtp/bugs/1291/ */
{ "Lenovo", 0x17ef, "A3500-F", 0x7737,
DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/support-requests/186/ */
+ { "Lenovo", 0x17ef, "Yoga Tablet 2 - 1050F", 0x77a4,
+ DEVICE_FLAGS_ANDROID_BUGS },
/* https://sourceforge.net/p/libmtp/support-requests/168/ */
{ "Lenovo", 0x17ef, "Yoga Tablet 2 Pro", 0x77b1,
DEVICE_FLAGS_ANDROID_BUGS },
/* https://sourceforge.net/p/libmtp/feature-requests/125/ */
{ "Lenovo", 0x17ef, "Vibe Z2", 0x77ea,
DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1360/ */
+ { "Lenovo", 0x17ef, "K3 Note", 0x7883,
+ DEVICE_FLAGS_ANDROID_BUGS },
/*
* Huawei
@@ -2435,6 +2516,15 @@
DEVICE_FLAGS_ANDROID_BUGS },
{ "Huawei", 0x12d1, "MTP device (ID2)", 0x1052,
DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1381/ */
+ { "Huawei", 0x12d1, "H60-L11", 0x1079,
+ DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1361/ */
+ { "Huawei", 0x12d1, "Ascend P8 ", 0x1082,
+ DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1418/ */
+ { "Huawei", 0x12d1, "Honor 3C ", 0x2012,
+ DEVICE_FLAGS_ANDROID_BUGS },
{ "Huawei", 0x12d1, "Mediapad (mode 0)", 0x360f,
DEVICE_FLAGS_ANDROID_BUGS },
// Reported by Bearsh <bearsh@users.sourceforge.net>
@@ -2452,6 +2542,8 @@
/* https://sourceforge.net/p/libmtp/bugs/672/ */
{ "ZTE", 0x19d2, "Grand X In", 0x0343, DEVICE_FLAGS_ANDROID_BUGS },
{ "ZTE", 0x19d2, "V985", 0x0383, DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1328/ */
+ { "ZTE", 0x19d2, "V5", 0xffce, DEVICE_FLAGS_ANDROID_BUGS },
/*
* HTC (High Tech Computer Corp)
@@ -2459,6 +2551,12 @@
* Steven Eastland <grassmonk@users.sourceforge.net>
* Kevin Cheng <kache@users.sf.net>
*/
+ /* https://sourceforge.net/p/libmtp/support-requests/181/ */
+ { "HTC", 0x0bb4, "HTC One M9 (MTP)", 0x040b,
+ DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1398/ */
+ { "HTC", 0x0bb4, "Spreadtrum SH57MYZ03342 (MTP)", 0x05e3,
+ DEVICE_FLAGS_ANDROID_BUGS },
/* reported by Mikkel Oscar Lyderik <mikkeloscar@gmail.com> */
{ "HTC", 0x0bb4, "HTC Desire 510 (MTP+ADB)", 0x05fd,
DEVICE_FLAGS_ANDROID_BUGS },
@@ -2545,6 +2643,9 @@
/* https://sourceforge.net/p/libmtp/bugs/1182/ */
{ "HTC", 0x0bb4, "Desire 310 (MTP)", 0x0ec6,
DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1420/ */
+ { "HTC", 0x0bb4, "Desire 816G (MTP)", 0x0edb,
+ DEVICE_FLAGS_ANDROID_BUGS },
{ "HTC", 0x0bb4, "HTC One (MTP+ADB+CDC)", 0x0f5f,
DEVICE_FLAGS_ANDROID_BUGS },
{ "HTC", 0x0bb4, "HTC One (MTP+CDC)", 0x0f60,
@@ -2658,6 +2759,9 @@
DEVICE_FLAGS_ANDROID_BUGS },
{ "Amazon", 0x1949, "Kindle Fire (ID5)", 0x0012,
DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1353/ */
+ { "Amazon", 0x1949, "Kindle Fire HD6", 0x00f2,
+ DEVICE_FLAGS_ANDROID_BUGS },
{ "Amazon", 0x1949, "Fire Phone", 0x0800,
DEVICE_FLAGS_ANDROID_BUGS },
@@ -2677,6 +2781,9 @@
DEVICE_FLAGS_ANDROID_BUGS },
{ "YiFang", 0x2207, "BQ Tesla", 0x0006,
DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1354/ */
+ { "Various", 0x2207, "Viewpia DR/bq Kepler Debugging", 0x0011,
+ DEVICE_FLAGS_ANDROID_BUGS },
/*
* Kobo
@@ -2708,6 +2815,8 @@
{ "Intel", 0x8087, "Foxconn iView i700", 0x0a15, DEVICE_FLAGS_ANDROID_BUGS },
/* https://sourceforge.net/p/libmtp/bugs/1237/ */
{ "Intel", 0x8087, "Telcast Air 3G", 0x0a5e, DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1338/ */
+ { "Intel", 0x8087, "Chuwi vi8", 0x0a5f, DEVICE_FLAGS_ANDROID_BUGS },
/*
* Xiaomi
@@ -2738,6 +2847,15 @@
DEVICE_FLAGS_ANDROID_BUGS },
{ "Xiaomi", 0x2717, "Mi-2 (MTP)", 0xf003,
DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1397/ */
+ { "Xiaomi", 0x2717, "Mi-2s (id2) (MTP)", 0xff40,
+ DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1339/ */
+ { "Xiaomi", 0x2717, "Mi-2s (MTP)", 0xff48,
+ DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1402/ */
+ { "Xiaomi", 0x2717, "Redmi 2 (MTP)", 0xff60,
+ DEVICE_FLAGS_ANDROID_BUGS },
/*
* XO Learning Tablet
@@ -2774,6 +2892,9 @@
/* https://sourceforge.net/p/libmtp/bugs/1304/ */
{ "Alcatel", 0x1bbb, "OneTouch 5042D (MTP)", 0xa00e,
DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1401/ */
+ { "Alcatel", 0x1bbb, "OneTouch Idol 3 (MTP)", 0xaf2b,
+ DEVICE_FLAGS_ANDROID_BUGS },
/* https://sourceforge.net/p/libmtp/feature-requests/114/ */
{ "Alcatel", 0x1bbb, "OneTouch 6034R", 0xf003,
DEVICE_FLAGS_ANDROID_BUGS },
@@ -2782,8 +2903,12 @@
* Kyocera
*/
{ "Kyocera", 0x0482, "Rise", 0x0571, DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/feature-requests/134/ */
+ { "Kyocera", 0x0482, "Torque Model E6715", 0x0059a, DEVICE_FLAGS_ANDROID_BUGS },
/* https://sourceforge.net/p/libmtp/discussion/535190/thread/6270f5ce/ */
{ "Kyocera", 0x0482, "KYL22", 0x0810, DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1345/ */
+ { "Kyocera", 0x0482, "DuraForce", 0x0979, DEVICE_FLAGS_ANDROID_BUGS },
/*
* HiSense
@@ -2798,12 +2923,20 @@
DEVICE_FLAGS_ANDROID_BUGS },
{ "Hewlett-Packard", 0x03f0, "Slate 7 2800", 0x5d1d,
DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1366/ */
+ { "Hewlett-Packard", 0x03f0, "Slate 10 HD", 0x7e1d,
+ DEVICE_FLAGS_ANDROID_BUGS },
/*
* MediaTek Inc.
*/
{ "MediaTek Inc", 0x0e8d, "MT5xx and MT6xx SoCs", 0x0050,
DEVICE_FLAGS_ANDROID_BUGS },
+ { "MediaTek Inc", 0x0e8d, "MT65xx", 0x2008,
+ DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/feature-requests/79/ */
+ { "MediaTek Inc", 0x0e8d, "Elephone P8000", 0x201d,
+ DEVICE_FLAGS_ANDROID_BUGS },
/*
* Jolla
@@ -2860,6 +2993,8 @@
{ "Prestigio", 0x29e4, "5505 DUO ", 0x1103, DEVICE_FLAGS_ANDROID_BUGS },
/* https://sourceforge.net/p/libmtp/bugs/1243/ */
{ "Prestigio", 0x29e4, "5504 DUO ", 0x1203, DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/feature-requests/141/ */
+ { "Prestigio", 0x29e4, "3405 DUO ", 0x3201, DEVICE_FLAGS_ANDROID_BUGS },
/* https://sourceforge.net/p/libmtp/bugs/1283/ */
{ "Megafon", 0x201e, "MFLogin3T", 0x42ab, DEVICE_FLAGS_ANDROID_BUGS },
@@ -2867,6 +3002,8 @@
/* https://sourceforge.net/p/libmtp/bugs/1287/ */
{ "Gensis", 0x040d, "GT-7305 ", 0x885c, DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/support-requests/182/ */
+ { "Oppo", 0x22d9, "Find 5", 0x2764, DEVICE_FLAGS_ANDROID_BUGS },
/* https://sourceforge.net/p/libmtp/bugs/1207/ */
{ "Oppo", 0x22d9, "Find 7 (ID 1)", 0x2765, DEVICE_FLAGS_ANDROID_BUGS },
/* https://sourceforge.net/p/libmtp/bugs/1277/ */
@@ -2916,6 +3053,14 @@
/* https://sourceforge.net/p/libmtp/bugs/1314/ */
{ "BenQ", 0x1d45, "F5", 0x459d, DEVICE_FLAGS_ANDROID_BUGS },
+ /* https://sourceforge.net/p/libmtp/bugs/1362/ */
+ { "TomTom", 0x1390, "Rider 40", 0x5455, DEVICE_FLAGS_ANDROID_BUGS },
+
+ /* https://sourceforge.net/p/libmtp/feature-requests/135/. guessed android. */
+ { "OUYA", 0x2836, "Videogame Console", 0x0010, DEVICE_FLAGS_ANDROID_BUGS },
+
+ /* https://sourceforge.net/p/libmtp/bugs/1383/ */
+ { "BLU", 0x0e8d, "Studio HD", 0x2008, DEVICE_FLAGS_ANDROID_BUGS },
/*
* Other strange stuff.
*/

187
gnu/packages/python.scm
View file

@ -783,6 +783,9 @@ (define-public python-keyring
;; "MIT" and PSF dual license
(license x11)))
(define-public python2-keyring
(package-with-python2 python-keyring))
(define-public python-six
(package
(name "python-six")
@ -3719,13 +3722,15 @@ (define-public python2-ipython
`(#:tests? #f ,@(package-arguments ipython)))
;; Make sure we use custom python2-NAME packages.
;; FIXME: add pyreadline once available.
(propagated-inputs
`(("python2-terminado" ,python2-terminado)
,@(alist-delete "python-terminado"
(package-propagated-inputs ipython))))
(inputs
`(("python2-mock" ,python2-mock)
("python2-matplotlib" ,python2-matplotlib)
("python2-terminado" ,python2-terminado)
,@(alist-delete "python-terminado"
(alist-delete "python-matplotlib"
(package-inputs ipython))))))))
,@(alist-delete "python-matplotlib"
(package-inputs ipython)))))))
(define-public python-isodate
(package
@ -4432,6 +4437,9 @@ (define-public python-pyflakes
"Pyflakes statically checks Python source code for common errors.")
(license license:expat)))
(define-public python2-pyflakes
(package-with-python2 python-pyflakes))
(define-public python-mccabe
(package
(name "python-mccabe")
@ -4495,7 +4503,7 @@ (define-public python-pyflakes-0.8.1
"0sbpq6pqm1i9wqi41mlfrsc5rk92jv4mskvlyxmnhlbdnc80ma1z"))))))
(define-public python2-pyflakes-0.8.1
(package-with-python2 python-pyflakes))
(package-with-python2 python-pyflakes-0.8.1))
(define-public python-flake8
(package
@ -4768,3 +4776,172 @@ (define-public python-msgpack
(define-public python2-msgpack
(package-with-python2 python-msgpack))
(define-public python-netaddr
(package
(name "python-netaddr")
(version "0.7.18")
(source
(origin
(method url-fetch)
(uri (string-append
"https://pypi.python.org/packages/source/n/netaddr/netaddr-"
version
".tar.gz"))
(sha256
(base32
"06dxjlbcicq7q3vqy8agq11ra01kvvd47j4mk6dmghjsyzyckxd1"))))
(build-system python-build-system)
(arguments `(#:tests? #f)) ;; No tests.
(inputs
`(("python-setuptools" ,python-setuptools)))
(home-page "https://github.com/drkjam/netaddr/")
(synopsis "Pythonic manipulation of network addresses")
(description
"A Python library for representing and manipulating IPv4, IPv6, CIDR, EUI
and MAC network addresses.")
(license bsd-3)))
(define-public python2-netaddr
(package-with-python2 python-netaddr))
(define-public python-wrapt
(package
(name "python-wrapt")
(version "1.10.5")
(source
(origin
(method url-fetch)
(uri (string-append
"https://pypi.python.org/packages/source/w/wrapt/wrapt-"
version
".tar.gz"))
(sha256
(base32
"0cq8rlpzkxzk48b50yrfhzn1d1hrq4gjcdqlrgq4v5palgiv9jwr"))))
(build-system python-build-system)
(arguments
;; Tests are not included in the tarball, they are only available in the
;; git repository.
`(#:tests? #f))
(inputs
`(("python-setuptools" ,python-setuptools)))
(home-page "https://github.com/GrahamDumpleton/wrapt")
(synopsis "Module for decorators, wrappers and monkey patching")
(description
"The aim of the wrapt module is to provide a transparent object proxy for
Python, which can be used as the basis for the construction of function
wrappers and decorator functions.")
(license bsd-2)))
(define-public python2-wrapt
(package-with-python2 python-wrapt))
(define-public python-iso8601
(package
(name "python-iso8601")
(version "0.1.10")
(source
(origin
(method url-fetch)
(uri (string-append
"https://pypi.python.org/packages/source/i/iso8601/iso8601-"
version
".tar.gz"))
(sha256
(base32
"1qf01afxh7j4gja71vxv345if8avg6nnm0ry0zsk6j3030xgy4p7"))))
(build-system python-build-system)
(inputs
`(("python-setuptools" ,python-setuptools)))
(home-page "https://bitbucket.org/micktwomey/pyiso8601")
(synopsis "Module to parse ISO 8601 dates")
(description
"This module parses the most common forms of ISO 8601 date strings (e.g.
@code{2007-01-14T20:34:22+00:00}) into @code{datetime} objects.")
(license license:expat)))
(define-public python2-iso8601
(package-with-python2 python-iso8601))
(define-public python-monotonic
(package
(name "python-monotonic")
(version "0.3")
(source
(origin
(method url-fetch)
(uri (string-append
"https://pypi.python.org/packages/source/m/monotonic/monotonic-"
version
".tar.gz"))
(sha256
(base32
"0yz0bcbwx8r2c01czzfpbrxddynxyk9k95jj8h6sgcb7xmfvl998"))))
(build-system python-build-system)
(inputs
`(("python-setuptools" ,python-setuptools)))
(home-page "https://github.com/atdt/monotonic")
(synopsis "Implementation of time.monotonic() for Python 2 & < 3.3")
(description
"This module provides a monotonic() function which returns the value (in
fractional seconds) of a clock which never goes backwards.")
(license asl2.0)))
(define-public python2-monotonic
(package-with-python2 python-monotonic))
(define-public python-webob
(package
(name "python-webob")
(version "1.5.0b0")
(source
(origin
(method url-fetch)
(uri (string-append
"https://pypi.python.org/packages/source/W/WebOb/WebOb-"
version ".tar.gz"))
(sha256
(base32
"140b3iczclk1j0405rvw5gxshqfkhcc8254fj520z3m23cwbql4a"))))
(build-system python-build-system)
(inputs
`(("python-nose" ,python-nose)
("python-setuptools" ,python-setuptools)))
(home-page "http://webob.org/")
(synopsis "WSGI request and response object")
(description
"WebOb provides wrappers around the WSGI request environment, and an
object to help create WSGI responses.")
(license license:expat)))
(define-public python2-webob
(package-with-python2 python-webob))
(define-public python-prettytable
(package
(name "python-prettytable")
(version "0.7.2")
(source
(origin
(method url-fetch)
(uri (string-append
"https://pypi.python.org/packages/source/P/PrettyTable/"
"prettytable-" version ".tar.bz2"))
(sha256
(base32
"0diwsicwmiq2cpzpxri7cyl5fmsvicafw6nfqf6p6p322dji2g45"))))
(build-system python-build-system)
(inputs
`(("python-setuptools" ,python-setuptools)))
(home-page "http://code.google.com/p/prettytable/")
(synopsis "Display tabular data in an ASCII table format")
(description
"A library designed to represent tabular data in visually appealing ASCII
tables. PrettyTable allows for selection of which columns are to be printed,
independent alignment of columns (left or right justified or centred) and
printing of sub-tables by specifying a row range.")
(license bsd-3)))
(define-public python2-prettytable
(package-with-python2 python-prettytable))

291
gnu/packages/ruby.scm
View file

@ -421,6 +421,30 @@ (define-public ruby-rjb
(home-page "http://www.artonx.org/collabo/backyard/?RubyJavaBridge")
(license license:lgpl2.1+)))
(define-public ruby-log4r
(package
(name "ruby-log4r")
(version "1.1.10")
(source
(origin
(method url-fetch)
(uri (rubygems-uri "log4r" version))
(sha256
(base32
"0ri90q0frfmigkirqv5ihyrj59xm8pq5zcmf156cbdv4r4l2jicv"))))
(build-system ruby-build-system)
(arguments
'(#:tests? #f)) ; no Rakefile in gem
(synopsis "Flexible logging library for Ruby")
(description "Comprehensive and flexible logging library written
in Ruby for use in Ruby programs. It features a hierarchical logging
system of any number of levels, custom level names, logger
inheritance, multiple output destinations per log event, execution
tracing, custom formatting, thread safteyness, XML and YAML
configuration, and more.")
(home-page "http://log4r.rubyforge.org/")
(license license:bsd-3)))
(define-public ruby-atoulme-antwrap
(package
(name "ruby-atoulme-antwrap")
@ -465,6 +489,34 @@ (define-public ruby-orderedhash
(home-page "http://codeforpeople.com/lib/ruby/orderedhash/")
(license license:public-domain)))
(define-public ruby-libxml
(package
(name "ruby-libxml")
(version "2.8.0")
(source
(origin
(method url-fetch)
(uri (rubygems-uri "libxml-ruby" version))
(sha256
(base32
"1dhjqp4r9vkdp00l6h1cj8qfndzxlhlxk6b9g0w4v55gz857ilhb"))))
(build-system ruby-build-system)
(inputs
`(("zlib" ,zlib)
("libxml2" ,libxml2)))
(arguments
'(#:tests? #f ; test suite hangs for unknown reason
#:gem-flags
(list "--"
(string-append "--with-xml2-include="
(assoc-ref %build-inputs "libxml2")
"/include/libxml2" ))))
(synopsis "Ruby bindings for GNOME Libxml2")
(description "The Libxml-Ruby project provides Ruby language bindings for
the GNOME Libxml2 XML toolkit.")
(home-page "http://xml4r.github.com/libxml-ruby")
(license license:expat)))
(define-public ruby-xml-simple
(package
(name "ruby-xml-simple")
@ -505,6 +557,152 @@ (define-public ruby-thor
(home-page "http://whatisthor.com/")
(license license:expat)))
(define-public ruby-lumberjack
(package
(name "ruby-lumberjack")
(version "1.0.9")
(source (origin
(method url-fetch)
(uri (rubygems-uri "lumberjack" version))
(sha256
(base32
"162frm2bwy58pj8ccsdqa4a6i0csrhb9h5l3inhkl1ivgfc8814l"))))
(build-system ruby-build-system)
(native-inputs
`(("ruby-rspec" ,ruby-rspec)))
(synopsis "Logging utility library for Ruby")
(description "Lumberjack is a simple logging utility that can be a drop in
replacement for Logger or ActiveSupport::BufferedLogger. It provides support
for automatically rolling log files even with multiple processes writing the
same log file.")
(home-page "http://github.com/bdurand/lumberjack")
(license license:expat)))
(define-public ruby-nenv
(package
(name "ruby-nenv")
(version "0.2.0")
(source (origin
(method url-fetch)
(uri (rubygems-uri "nenv" version))
(sha256
(base32
"152wxwri0afwgnxdf93gi6wjl9rr5z7vwp8ln0gpa3rddbfc27s6"))))
(build-system ruby-build-system)
(arguments
`(#:tests? #f)) ; no tests included
(native-inputs
`(("ruby-rspec" ,ruby-rspec)
("bundler" ,bundler)))
(synopsis "Ruby interface for modifying the environment")
(description "Nenv provides a convenient wrapper for Ruby's ENV to modify
and inspect the environment.")
(home-page "https://github.com/e2/nenv")
(license license:expat)))
(define-public ruby-shellany
(package
(name "ruby-shellany")
(version "0.0.1")
(source (origin
(method url-fetch)
(uri (rubygems-uri "shellany" version))
(sha256
(base32
"1ryyzrj1kxmnpdzhlv4ys3dnl2r5r3d2rs2jwzbnd1v96a8pl4hf"))))
(build-system ruby-build-system)
(arguments
`(#:test-target "default"
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'fix-version-test
(lambda _
(substitute* "spec/shellany_spec.rb"
(("^RSpec") "require \"shellany\"\nRSpec"))
#t)))))
(native-inputs
`(("ruby-rspec" ,ruby-rspec)
("ruby-nenv" ,ruby-nenv)
("bundler" ,bundler)))
(synopsis "Capture command output")
(description "Shellany is a Ruby library providing functions to capture
the output produced by running shell commands.")
(home-page "https://rubygems.org/gems/shellany")
(license license:expat)))
(define-public ruby-notiffany
(package
(name "ruby-notiffany")
(version "0.0.7")
(source (origin
(method url-fetch)
(uri (rubygems-uri "notiffany" version))
(sha256
(base32
"1v5x1w59qq85r6dpv3y9ga34dfd7hka1qxyiykaw7gm0i6kggbhi"))))
(build-system ruby-build-system)
;; Tests are not included in the gem.
(arguments `(#:tests? #f))
(propagated-inputs
`(("ruby-shellany" ,ruby-shellany)
("ruby-nenv" ,ruby-nenv)))
(native-inputs
`(("bundler" ,bundler)))
(synopsis "Wrapper libray for notification libraries")
(description "Notiffany is a Ruby wrapper libray for notification
libraries such as Libnotify.")
(home-page "https://github.com/guard/notiffany")
(license license:expat)))
(define-public ruby-formatador
(package
(name "ruby-formatador")
(version "0.2.5")
(source (origin
(method url-fetch)
(uri (rubygems-uri "formatador" version))
(sha256
(base32
"1gc26phrwlmlqrmz4bagq1wd5b7g64avpx0ghxr9xdxcvmlii0l0"))))
(build-system ruby-build-system)
;; Circular dependency: Tests require ruby-shindo, which requires
;; ruby-formatador at runtime.
(arguments `(#:tests? #f))
(synopsis "Ruby library to format text on stdout")
(description "Formatador is a Ruby library to format text printed to the
standard output stream.")
(home-page "http://github.com/geemus/formatador")
(license license:expat)))
(define-public ruby-shindo
(package
(name "ruby-shindo")
(version "0.3.8")
(source (origin
(method url-fetch)
(uri (rubygems-uri "shindo" version))
(sha256
(base32
"0s8v1jbz8i0jh92f2fgxb3p51l1azrpkc8nv4mhrqy4vndpvd7wq"))))
(build-system ruby-build-system)
(arguments
`(#:test-target "shindo_tests"
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'fix-tests
(lambda _
(substitute* "Rakefile"
(("system \"shindo") "system \"./bin/shindo")
;; This test doesn't work, so we disable it.
(("fail \"The build_error test should fail") "#"))
#t)))))
(propagated-inputs
`(("ruby-formatador" ,ruby-formatador)))
(synopsis "Simple depth first Ruby testing")
(description "Shindo is a simple depth first testing library for Ruby.")
(home-page "https://github.com/geemus/shindo")
(license license:expat)))
(define-public ruby-useragent
(package
(name "ruby-useragent")
@ -1124,3 +1322,96 @@ (define-public ruby-rack
into a single method call.")
(home-page "http://rack.github.io/")
(license license:expat)))
(define-public ruby-docile
(package
(name "ruby-docile")
(version "1.1.5")
(source
(origin
(method url-fetch)
(uri (rubygems-uri "docile" version))
(sha256
(base32
"0m8j31whq7bm5ljgmsrlfkiqvacrw6iz9wq10r3gwrv5785y8gjx"))))
(build-system ruby-build-system)
(arguments
'(#:tests? #f)) ; needs github-markup, among others
(synopsis "Ruby EDSL helper library")
(description "Docile is a Ruby library that provides an interface for
creating embedded domain specific languages (EDSLs) that manipulate existing
Ruby classes.")
(home-page "https://ms-ati.github.io/docile/")
(license license:expat)))
(define-public ruby-gherkin3
(package
(name "ruby-gherkin3")
(version "3.1.1")
(source
(origin
(method url-fetch)
(uri (rubygems-uri "gherkin3" version))
(sha256
(base32
"0xsyxhqa1gwcxzvsdy4didaiq5vam8ma3fbwbw2w60via4k6r1z9"))))
(build-system ruby-build-system)
(native-inputs
`(("bundler" ,bundler)))
(arguments
'(#:tests? #f)) ; needs simplecov, among others
(synopsis "Gherkin parser for Ruby")
(description "Gherkin 3 is a parser and compiler for the Gherkin language.
It is intended to replace Gherkin 2 and be used by all Cucumber
implementations to parse '.feature' files.")
(home-page "https://github.com/cucumber/gherkin3")
(license license:expat)))
(define-public ruby-cucumber-core
(package
(name "ruby-cucumber-core")
(version "1.3.0")
(source
(origin
(method url-fetch)
(uri (rubygems-uri "cucumber-core" version))
(sha256
(base32
"12mrzf0s96izpq0k10lahlkgwc4fjs0zfs344rh8r8h3w3jyppr8"))))
(build-system ruby-build-system)
(propagated-inputs
`(("ruby-gherkin3" ,ruby-gherkin3)))
(native-inputs
`(("bundler" ,bundler)))
(arguments
'(#:tests? #f)) ; needs simplecov, among others
(synopsis "Core library for the Cucumber BDD app")
(description "Cucumber is a tool for running automated tests
written in plain language. Because they're written in plain language,
they can be read by anyone on your team. Because they can be read by
anyone, you can use them to help improve communication, collaboration
and trust on your team.")
(home-page "https://cucumber.io/")
(license license:expat)))
(define-public ruby-bio-logger
(package
(name "ruby-bio-logger")
(version "1.0.1")
(source
(origin
(method url-fetch)
(uri (rubygems-uri "bio-logger" version))
(sha256
(base32
"02pylfy8nkdqzyzplvnhn1crzmfkj1zmi3qjhrj2f2imlxvycd28"))))
(build-system ruby-build-system)
(arguments
`(#:tests? #f)) ; rake errors, missing shoulda
(propagated-inputs
`(("ruby-log4r" ,ruby-log4r)))
(synopsis "Log4r wrapper for Ruby")
(description "Bio-logger is a wrapper around Log4r adding extra logging
features such as filtering and fine grained logging.")
(home-page "https://github.com/pjotrp/bioruby-logger-plugin")
(license license:expat)))

177
gnu/packages/scheme.scm
View file

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;;
;;; This file is part of GNU Guix.
;;;
@ -486,3 +487,179 @@ (define-public chibi-scheme
an isolated heap allowing multiple VMs to run simultaneously in different OS
threads.")
(license bsd-3)))
;; FIXME: This function is temporarily in the engineering module and not
;; exported. It will be moved to an utility module for general use. Once
;; this is done, we should remove this definition.
(define broken-tarball-fetch
(@@ (gnu packages engineering) broken-tarball-fetch))
(define-public scmutils
(let ()
(define (system-suffix)
(cond
((string-prefix? "x86_64" (or (%current-target-system)
(%current-system)))
"x86-64")
(else "i386")))
(package
(name "scmutils")
(version "20140302")
(source
(origin
(method broken-tarball-fetch)
(modules '((guix build utils)))
(snippet
;; Remove binary code
'(delete-file-recursively "scmutils/mit-scheme"))
(file-name (string-append name "-" version ".tar.gz"))
(uri (string-append "http://groups.csail.mit.edu/mac/users/gjs/6946"
"/scmutils-tarballs/" name "-" version
"-x86-64-gnu-linux.tar.gz"))
(sha256
(base32 "10cnbm7nh78m5mrl1di85s29gny81jb1am9zd9f9yx725xb6dnfg"))))
(build-system gnu-build-system)
(inputs
`(("mit-scheme" ,mit-scheme)
("emacs" ,emacs-no-x)))
(arguments
`(#:tests? #f ;; no tests-suite
#:modules ((guix build gnu-build-system)
(guix build utils)
(guix build emacs-utils))
#:imported-modules (,@%gnu-build-system-modules
(guix build emacs-utils))
#:phases
(modify-phases %standard-phases
(replace 'configure
;; No standard build procedure is used. We set the correct
;; runtime path in the custom build system.
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
;; Required to find .bci files at runtime.
(with-directory-excursion "scmutils"
(rename-file "src" "scmutils"))
(substitute* "scmutils/scmutils/load.scm"
(("/usr/local/scmutils/")
(string-append out "/lib/mit-scheme-"
,(system-suffix) "/")))
#t)))
(replace 'build
;; Compile the code and build a band.
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(make-img (string-append
"echo '(load \"load\") "
"(disk-save \"edwin-mechanics.com\")'"
"| mit-scheme")))
(with-directory-excursion "scmutils/scmutils"
(and (zero? (system "mit-scheme < compile.scm"))
(zero? (system make-img)))))))
(add-before 'install 'fix-directory-names
;; Correct directory names in the startup script.
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(scm-root (assoc-ref inputs "mit-scheme")))
(substitute* "bin/mechanics"
(("ROOT=\"\\$\\{SCMUTILS_ROOT:-/.*\\}\"")
(string-append
"ROOT=\"${SCMUTILS_ROOT:-" scm-root "}\"\n"
"LIB=\"${ROOT}/lib/mit-scheme-"
,(system-suffix) ":"
out "/lib/mit-scheme-" ,(system-suffix) "\""))
(("EDWIN_INFO_DIRECTORY=.*\n") "")
(("SCHEME=.*\n")
(string-append "SCHEME=\"${ROOT}/bin/scheme "
"--library ${LIB}\"\n"))
(("export EDWIN_INFO_DIRECTORY") ""))
#t)))
(add-before 'install 'emacs-tags
;; Generate Emacs's tags for easy reference to source
;; code.
(lambda* (#:key inputs outputs #:allow-other-keys)
(with-directory-excursion "scmutils/scmutils"
(zero? (apply system* "etags"
(find-files "." "\\.scm"))))))
(replace 'install
;; Copy files to the store.
(lambda* (#:key outputs #:allow-other-keys)
(define* (copy-files-to-directory files dir
#:optional (delete? #f))
(for-each (lambda (f)
(copy-file f (string-append dir "/" f))
(when delete? (delete-file f)))
files))
(let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin"))
(doc (string-append out "/share/doc/"
,name "-" ,version))
(lib (string-append out "/lib/mit-scheme-"
,(system-suffix)
"/scmutils")))
(for-each mkdir-p (list lib doc bin))
(with-directory-excursion "scmutils/scmutils"
(copy-files-to-directory '("COPYING" "LICENSE")
doc #t)
(for-each delete-file (find-files "." "\\.bin"))
(copy-files-to-directory '("edwin-mechanics.com")
(string-append lib "/..") #t)
(copy-recursively "." lib))
(with-directory-excursion "bin"
(copy-files-to-directory (find-files ".") bin))
(with-directory-excursion "scmutils/manual"
(copy-files-to-directory (find-files ".") doc))
#t)))
(add-after 'install 'emacs-helpers
;; Add convenience Emacs commands to easily load the
;; Scmutils band in an MIT-Scheme buffer inside of Emacs
;; and to easily load code tags.
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(mit-root (assoc-ref inputs "mit-scheme"))
(emacs-lisp-dir
(string-append out "/share/emacs/site-lisp"
"/guix.d/" ,name "-" ,version))
(el-file (string-append emacs-lisp-dir
"/scmutils.el"))
(lib-relative-path
(string-append "/lib/mit-scheme-"
,(system-suffix))))
(mkdir-p emacs-lisp-dir)
(call-with-output-file el-file
(lambda (p)
(format p
";;;###autoload
(defun scmutils-load ()
(interactive)
(require 'xscheme)
(let ((mit-root \"~a\")
(scmutils \"~a\"))
(run-scheme
(concat mit-root \"/bin/scheme --library \"
mit-root \"~a:\" scmutils \"~a\"
\" --band edwin-mechanics.com\"
\" --emacs\"))))
;;;###autoload
(defun scmutils-load-tags ()
(interactive)
(let ((scmutils \"~a\"))
(visit-tags-table (concat scmutils \"/TAGS\"))))
"
mit-root out
lib-relative-path
lib-relative-path
(string-append out lib-relative-path
"/scmutils"))))
(emacs-byte-compile-directory (dirname el-file))
#t))))))
(home-page
"http://groups.csail.mit.edu/mac/users/gjs/6946/linux-install.htm")
(synopsis "Scmutils library for MIT Scheme")
(description "The Scmutils system is an integrated library of
procedures, embedded in the programming language Scheme, and intended to
support teaching and research in mathematical physics and electrical
engineering.")
(license gpl2+))))

462
gnu/packages/statistics.scm
View file

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2015 Vicente Vera Parra <vicentemvp@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -140,8 +141,7 @@ (define-public r-colorspace
(source
(origin
(method url-fetch)
(uri (string-append "mirror://cran/src/contrib/colorspace_"
version ".tar.gz"))
(uri (cran-uri "colorspace" version))
(sha256
(base32 "0y8n4ljwhbdvkysdwgqzcnpv107pb3px1jip3k6svv86p72nacds"))))
(build-system r-build-system)
@ -161,8 +161,7 @@ (define-public r-dichromat
(source
(origin
(method url-fetch)
(uri (string-append "mirror://cran/src/contrib/dichromat_"
version ".tar.gz"))
(uri (cran-uri "dichromat" version))
(sha256
(base32 "1l8db1nk29ccqg3mkbafvfiw0775iq4gapysf88xq2zp6spiw59i"))))
(build-system r-build-system)
@ -180,8 +179,7 @@ (define-public r-digest
(source
(origin
(method url-fetch)
(uri (string-append "mirror://cran/src/contrib/digest_"
version ".tar.gz"))
(uri (cran-uri "digest" version))
(sha256
(base32 "0m9grqv67hhf51lz10whymhw0g0d98466ka694kya5x95hn44qih"))))
(build-system r-build-system)
@ -206,8 +204,7 @@ (define-public r-gtable
(source
(origin
(method url-fetch)
(uri (string-append "mirror://cran/src/contrib/gtable_"
version ".tar.gz"))
(uri (cran-uri "gtable" version))
(sha256
(base32 "0k9hfj6r5y238gqh92s3cbdn34biczx3zfh79ix5xq0c5vkai2xh"))))
(build-system r-build-system)
@ -225,8 +222,7 @@ (define-public r-labeling
(source
(origin
(method url-fetch)
(uri (string-append "mirror://cran/src/contrib/labeling_"
version ".tar.gz"))
(uri (cran-uri "labeling" version))
(sha256
(base32 "13sk7zrrrzry6ky1bp8mmnzcl9jhvkig8j4id9nny7z993mnk00d"))))
(build-system r-build-system)
@ -243,8 +239,7 @@ (define-public r-magrittr
(source
(origin
(method url-fetch)
(uri (string-append "mirror://cran/src/contrib/magrittr_"
version ".tar.gz"))
(uri (cran-uri "magrittr" version))
(sha256
(base32 "1s1ar6rag8m277qcqmdp02gn4awn9bdj9ax0r8s32i59mm1mki05"))))
(build-system r-build-system)
@ -265,8 +260,7 @@ (define-public r-munsell
(source
(origin
(method url-fetch)
(uri (string-append "mirror://cran/src/contrib/munsell_"
version ".tar.gz"))
(uri (cran-uri "munsell" version))
(sha256
(base32 "1bi5yi0i80778bbzx2rm4f0glpc34kvh24pwwfhm4v32izsqgrw4"))))
(build-system r-build-system)
@ -286,8 +280,7 @@ (define-public r-rcpp
(source
(origin
(method url-fetch)
(uri (string-append "mirror://cran/src/contrib/Rcpp_"
version ".tar.gz"))
(uri (cran-uri "Rcpp" version))
(sha256
(base32 "182109z0yc1snqgd833ssl2cix6cbq83bcxmy5344b15ym820y38"))))
(build-system r-build-system)
@ -311,8 +304,7 @@ (define-public r-plyr
(source
(origin
(method url-fetch)
(uri (string-append "mirror://cran/src/contrib/plyr_"
version ".tar.gz"))
(uri (cran-uri "plyr" version))
(sha256
(base32 "06v4zxawpjz37rp2q2ii5q43g664z9s29j4ydn0cz3crn7lzl6pk"))))
(build-system r-build-system)
@ -334,7 +326,7 @@ (define-public r-proto
(source
(origin
(method url-fetch)
(uri (string-append "mirror://cran/src/contrib/proto_" version ".tar.gz"))
(uri (cran-uri "proto" version))
(sha256
(base32 "03mvzi529y6kjcp9bkpk7zlgpcakb3iz73hca6rpjy14pyzl3nfh"))))
(build-system r-build-system)
@ -352,8 +344,7 @@ (define-public r-rcolorbrewer
(source
(origin
(method url-fetch)
(uri (string-append "mirror://cran/src/contrib/RColorBrewer_"
version ".tar.gz"))
(uri (cran-uri "RColorBrewer" version))
(sha256
(base32 "1pfcl8z1pnsssfaaz9dvdckyfnnc6rcq56dhislbf571hhg7isgk"))))
(build-system r-build-system)
@ -372,10 +363,7 @@ (define-public r-stringi
(source
(origin
(method url-fetch)
(uri (string-append
"mirror://cran/src/contrib/stringi_"
version
".tar.gz"))
(uri (cran-uri "stringi" version))
(sha256
(base32
"183wrrjhpgl1wbnn9lhghyvhz7l2mc64mpcmzplckal7y9j7pmhw"))))
@ -401,8 +389,7 @@ (define-public r-stringr
(source
(origin
(method url-fetch)
(uri (string-append "mirror://cran/src/contrib/stringr_"
version ".tar.gz"))
(uri (cran-uri "stringr" version))
(sha256
(base32 "0jnz6r9yqyf7dschr2fnn1slg4wn6b4ik5q00j4zrh43bfw7s9pq"))))
(build-system r-build-system)
@ -426,8 +413,7 @@ (define-public r-reshape2
(source
(origin
(method url-fetch)
(uri (string-append "mirror://cran/src/contrib/reshape2_"
version ".tar.gz"))
(uri (cran-uri "reshape2" version))
(sha256
(base32 "0hl082dyk3pk07nqprpn5dvnrkqhnf6zjnjig1ijddxhlmsrzm7v"))))
(build-system r-build-system)
@ -449,8 +435,7 @@ (define-public r-scales
(source
(origin
(method url-fetch)
(uri (string-append "mirror://cran/src/contrib/scales_"
version ".tar.gz"))
(uri (cran-uri "scales" version))
(sha256
(base32 "1kkgpqzb0a6lnpblhcprr4qzyfk5lhicdv4639xs5cq16n7bkqgl"))))
(build-system r-build-system)
@ -476,8 +461,7 @@ (define-public r-ggplot2
(source
(origin
(method url-fetch)
(uri (string-append "mirror://cran/src/contrib/ggplot2_"
version ".tar.gz"))
(uri (cran-uri "ggplot2" version))
(sha256
(base32 "0794kjqi3lrxb33lr1mykd58959hlgkhdn259vj8fxrh65mqw920"))))
(build-system r-build-system)
@ -498,3 +482,415 @@ (define-public r-ggplot2
multidimensional conditioning system and a consistent interface to map data to
aesthetic attributes.")
(license license:gpl2+)))
(define-public r-assertthat
(package
(name "r-assertthat")
(version "0.1")
(source (origin
(method url-fetch)
(uri (cran-uri "assertthat" version))
(sha256
(base32
"0dwsqajyglfscqilj843qfqn1ndbqpswa7b4l1d633qjk9d68qqk"))))
(build-system r-build-system)
(home-page "https://github.com/hadley/assertthat")
(synopsis "Easy pre and post assertions")
(description
"Assertthat is an extension to stopifnot() that makes it easy to declare
the pre and post conditions that your code should satisfy, while also
producing friendly error messages so that your users know what they've done
wrong.")
(license license:gpl3+)))
(define-public r-lazyeval
(package
(name "r-lazyeval")
(version "0.1.10")
(source (origin
(method url-fetch)
(uri (cran-uri "lazyeval" version))
(sha256
(base32
"02qfpn2fmy78vx4jxr7g7rhqzcm1kcivfwai7lbh0vvpawia0qwh"))))
(build-system r-build-system)
(home-page "https://github.com/hadley/lazyeval")
(synopsis "Lazy (non-standard) evaluation in R")
(description
"This package provides the tools necessary to do non-standard
evaluation (NSE) in R.")
(license license:gpl3+)))
(define-public r-dbi
(package
(name "r-dbi")
(version "0.3.1")
(source (origin
(method url-fetch)
(uri (cran-uri "DBI" version))
(sha256
(base32
"0xj5baxwnhl23rd5nskhjvranrwrc68f3xlyrklglipi41bm69hw"))))
(build-system r-build-system)
(home-page "https://github.com/rstats-db/DBI")
(synopsis "R database interface")
(description
"The DBI package provides a database interface (DBI) definition for
communication between R and relational database management systems. All
classes in this package are virtual and need to be extended by the various
R/DBMS implementations.")
(license license:lgpl2.0+)))
(define-public r-bh
(package
(name "r-bh")
(version "1.58.0-1")
(source (origin
(method url-fetch)
(uri (cran-uri "BH" version))
(sha256
(base32
"17rnwyw9ib2pvm60iixzkbz7ff4fslpifp1nlx4czp42hy67kqpf"))))
(build-system r-build-system)
(home-page "https://github.com/eddelbuettel/bh")
(synopsis "R package providing subset of Boost headers")
(description
"This package aims to provide the most useful subset of Boost libraries
for template use among CRAN packages.")
(license license:boost1.0)))
(define-public r-evaluate
(package
(name "r-evaluate")
(version "0.8")
(source (origin
(method url-fetch)
(uri (cran-uri "evaluate" version))
(sha256
(base32
"137gc35jlizhqnx19mxim3llrkm403abj8ghb2b7v5ls9rvd40pq"))))
(build-system r-build-system)
(propagated-inputs
`(("r-stringr" ,r-stringr)))
(home-page "https://github.com/hadley/evaluate")
(synopsis "Parsing and evaluation tools for R")
(description
"This package provides tools that allow you to recreate the parsing,
evaluation and display of R code, with enough information that you can
accurately recreate what happens at the command line. The tools can easily be
adapted for other output formats, such as HTML or LaTeX.")
(license license:gpl3+)))
(define-public r-formatr
(package
(name "r-formatr")
(version "1.2.1")
(source (origin
(method url-fetch)
(uri (cran-uri "formatR" version))
(sha256
(base32
"0f4cv2zv5wayyqx99ybfyl0p83kgjvnsv8dhcwa4s49kw6jsx1lr"))))
(build-system r-build-system)
(home-page "http://yihui.name/formatR")
(synopsis "Format R code automatically")
(description
"This package provides a function to format R source code. Spaces and
indent will be added to the code automatically, and comments will be preserved
under certain conditions, so that R code will be more human-readable and tidy.
There is also a Shiny app as a user interface in this package.")
(license license:gpl3+)))
(define-public r-highr
(package
(name "r-highr")
(version "0.5.1")
(source (origin
(method url-fetch)
(uri (cran-uri "highr" version))
(sha256
(base32
"11hyawzhaw3ph5y5xphi7alx6df1d0i6wh0a2n5m4sxxhdrzswnb"))))
(build-system r-build-system)
(home-page "https://github.com/yihui/highr")
(synopsis "Syntax highlighting for R source code")
(description
"This package provides syntax highlighting for R source code. Currently
it supports LaTeX and HTML output. Source code of other languages is
supported via Andre Simon's highlight package.")
(license license:gpl3+)))
(define-public r-mime
(package
(name "r-mime")
(version "0.4")
(source (origin
(method url-fetch)
(uri (cran-uri "mime" version))
(sha256
(base32
"145cdcg252w2zsq67dmvmsqka60msfp7agymlxs3gl3ihgiwg46p"))))
(build-system r-build-system)
(home-page "https://github.com/yihui/mime")
(synopsis "R package to map filenames to MIME types")
(description
"This package guesses the MIME type from a filename extension using the
data derived from /etc/mime.types in UNIX-type systems.")
(license license:gpl2)))
(define-public r-markdown
(package
(name "r-markdown")
(version "0.7.7")
(source (origin
(method url-fetch)
(uri (cran-uri "markdown" version))
(sha256
(base32
"00j1hlib3il50azs2vlcyhi0bjpx1r50mxr9w9dl5g1bwjjc71hb"))))
(build-system r-build-system)
;; Skip check phase because the tests require the r-knitr package to be
;; installed. This prevents installation failures. Knitr normally
;; shouldn't be available since r-markdown is a dependency of the r-knitr
;; package.
(arguments `(#:tests? #f))
(propagated-inputs
`(("r-mime" ,r-mime)))
(home-page "https://github.com/rstudio/markdown")
(synopsis "Markdown rendering for R")
(description
"This package provides R bindings to the Sundown Markdown rendering
library (https://github.com/vmg/sundown). Markdown is a plain-text formatting
syntax that can be converted to XHTML or other formats.")
(license license:gpl2)))
(define-public r-yaml
(package
(name "r-yaml")
(version "2.1.13")
(source (origin
(method url-fetch)
(uri (cran-uri "yaml" version))
(sha256
(base32
"18kz5mfn7qpif5pn91w4vbrc5bkycsj85vwm5wxwzjlb02i9mxi6"))))
(build-system r-build-system)
(home-page "https://cran.r-project.org/web/packages/yaml/")
(synopsis "Methods to convert R data to YAML and back")
(description
"This package implements the libyaml YAML 1.1 parser and
emitter (http://pyyaml.org/wiki/LibYAML) for R.")
(license license:bsd-3)))
(define-public r-knitr
(package
(name "r-knitr")
(version "1.11")
(source (origin
(method url-fetch)
(uri (cran-uri "knitr" version))
(sha256
(base32
"1ikjla0hnpjfkdbydqhhqypc0aiizbi4nyn8c694sdk9ca4jasdd"))))
(build-system r-build-system)
(propagated-inputs
`(("r-evaluate" ,r-evaluate)
("r-digest" ,r-digest)
("r-formatr" ,r-formatr)
("r-highr" ,r-highr)
("r-markdown" ,r-markdown)
("r-stringr" ,r-stringr)
("r-yaml" ,r-yaml)))
(home-page "http://yihui.name/knitr/")
(synopsis "General-purpose package for dynamic report generation in R")
(description
"This package provides a general-purpose tool for dynamic report
generation in R using Literate Programming techniques.")
;; The code is released under any version of the GPL. As it is used by
;; r-markdown which is available under GPLv2 only, we have chosen GPLv2+
;; here.
(license license:gpl2+)))
(define-public r-microbenchmark
(package
(name "r-microbenchmark")
(version "1.4-2")
(source (origin
(method url-fetch)
(uri (cran-uri "microbenchmark" version))
(sha256
(base32
"05yxvdnkxr2ll94h6f2m5sn3gg7vrlm9nbdxgmj2g8cp8gfxpfkg"))))
(build-system r-build-system)
(propagated-inputs
`(("r-ggplot2" ,r-ggplot2)))
(home-page "https://cran.r-project.org/web/packages/microbenchmark/")
(synopsis "Accurate timing functions for R")
(description
"This package provides infrastructure to accurately measure and compare
the execution time of R expressions.")
(license license:bsd-2)))
(define-public r-codetools
(package
(name "r-codetools")
(version "0.2-14")
(source (origin
(method url-fetch)
(uri (cran-uri "codetools" version))
(sha256
(base32
"0y9r4m2b8xgavr89sc179knzwpz54xljbc1dinpq2q07i4xn0397"))))
(build-system r-build-system)
(home-page "https://cran.r-project.org/web/packages/codetools/index.html")
(synopsis "Code analysis tools for R")
(description "This package provides code analysis tools for R.")
(license license:gpl3+)))
(define-public r-pryr
(package
(name "r-pryr")
(version "0.1.2")
(source (origin
(method url-fetch)
(uri (cran-uri "pryr" version))
(sha256
(base32
"1in350a8hxwf580afavasvn3jc7x2p1b7nlwmj1scakfz74vghk5"))))
(build-system r-build-system)
(propagated-inputs
`(("r-stringr" ,r-stringr)
("r-codetools" ,r-codetools)))
(native-inputs
`(("r-rcpp" ,r-rcpp)))
(home-page "https://github.com/hadley/pryr")
(synopsis "Tools for computing on the R language")
(description
"This package provides useful tools to pry back the covers of R and
understand the language at a deeper level.")
(license license:gpl2)))
(define-public r-memoise
(package
(name "r-memoise")
(version "0.2.1")
(source (origin
(method url-fetch)
(uri (cran-uri "memoise" version))
(sha256
(base32
"19wm4b3kq6xva43kga3xydnl7ybl5mq7b4y2fczgzzjz63jd75y4"))))
(build-system r-build-system)
(propagated-inputs
`(("r-digest" ,r-digest)))
(home-page "http://github.com/hadley/memoise")
(synopsis "Memoise functions for R")
(description
"This R package allows to cache the results of a function so that when
you call it again with the same arguments it returns the pre-computed value.")
(license license:expat)))
(define-public r-crayon
(package
(name "r-crayon")
(version "1.3.1")
(source (origin
(method url-fetch)
(uri (cran-uri "crayon" version))
(sha256
(base32
"0d38fm06h272a8iqlc0d45m2rh36giwqw7mwq4z8hkp4vs975fmm"))))
(build-system r-build-system)
(propagated-inputs
`(("r-memoise" ,r-memoise)))
(home-page "https://github.com/gaborcsardi/crayon")
(synopsis "Colored terminal output for R")
(description
"Colored terminal output on terminals that support ANSI color and
highlight codes. It also works in Emacs ESS. ANSI color support is
automatically detected. Colors and highlighting can be combined and nested.
New styles can also be created easily. This package was inspired by the
\"chalk\" JavaScript project.")
(license license:expat)))
(define-public r-testthat
(package
(name "r-testthat")
(version "0.10.0")
(source (origin
(method url-fetch)
(uri (cran-uri "testthat" version))
(sha256
(base32
"0b3akwcx5mv9dmi8vssbk91hr3yrrdxd2fm6zhr31fnyz8kjx4pw"))))
(build-system r-build-system)
(propagated-inputs
`(("r-digest" ,r-digest)
("r-crayon" ,r-crayon)))
(home-page "https://github.com/hadley/testthat")
(synopsis "Unit testing for R")
(description
"This package provides a unit testing system for R designed to be fun,
flexible and easy to set up.")
(license license:expat)))
(define-public r-r6
(package
(name "r-r6")
(version "2.1.1")
(source (origin
(method url-fetch)
(uri (cran-uri "R6" version))
(sha256
(base32
"16qq35bgxgswf989yvsqkb6fv7srpf8n8dv2s2c0z9n6zgmwq66m"))))
(build-system r-build-system)
(propagated-inputs
`(("r-knitr" ,r-knitr)
("r-microbenchmark" ,r-microbenchmark)
("r-pryr" ,r-pryr)
("r-testthat" ,r-testthat)
("r-ggplot2" ,r-ggplot2)
("r-scales" ,r-scales)))
(home-page "https://github.com/wch/R6/")
(synopsis "Classes with reference semantics in R")
(description
"The R6 package allows the creation of classes with reference semantics,
similar to R's built-in reference classes. Compared to reference classes, R6
classes are simpler and lighter-weight, and they are not built on S4 classes
so they do not require the methods package. These classes allow public and
private members, and they support inheritance, even when the classes are
defined in different packages.")
(license license:expat)))
(define-public r-dplyr
(package
(name "r-dplyr")
(version "0.4.3")
(source (origin
(method url-fetch)
(uri (cran-uri "dplyr" version))
(sha256
(base32
"1p8rbn4p4yrx2840dapwiahf9iqa8gnvd35nyc200wfhmrxlqdlc"))))
(build-system r-build-system)
(propagated-inputs
`(("r-assertthat" ,r-assertthat)
("r-r6" ,r-r6)
("r-magrittr" ,r-magrittr)
("r-lazyeval" ,r-lazyeval)
("r-dbi" ,r-dbi)))
(native-inputs
`(("r-rcpp" ,r-rcpp)
("r-bh" ,r-bh)))
(home-page "https://github.com/hadley/dplyr")
(synopsis "Tools for working with data frames in R")
(description
"dplyr is the next iteration of plyr. It is focussed on tools for
working with data frames. It has three main goals: 1) identify the most
important data manipulation tools needed for data analysis and make them easy
to use in R; 2) provide fast performance for in-memory data by writing key
pieces of code in C++; 3) use the same code interface to work with data no
matter where it is stored, whether in a data frame, a data table or
database.")
(license license:expat)))

42
gnu/packages/version-control.scm
View file

@ -3,6 +3,7 @@
;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org>
;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;;
@ -34,10 +35,12 @@ (define-module (gnu packages version-control)
#:use-module (guix build-system trivial)
#:use-module (guix build utils)
#:use-module (gnu packages apr)
#:use-module (gnu packages asciidoc)
#:use-module (gnu packages base)
#:use-module (gnu packages bison)
#:use-module (gnu packages cook)
#:use-module (gnu packages curl)
#:use-module (gnu packages docbook)
#:use-module (gnu packages ed)
#:use-module (gnu packages file)
#:use-module (gnu packages flex)
@ -681,6 +684,45 @@ (define-public cvs
RCS, PRCS, and Aegis packages.")
(license gpl1+)))
(define-public cvs-fast-export
(package
(name "cvs-fast-export")
(version "1.33")
(source (origin
(method url-fetch)
(uri (string-append "http://www.catb.org/~esr/"
name "/" name "-" version ".tar.gz"))
(sha256
(base32
"1c3s4nacbwlaaccx1fr7hf72kxxrzy49y2rdz5hhqbk8r29vm8w1"))))
(build-system gnu-build-system)
(arguments
`(#:phases (modify-phases %standard-phases (delete 'configure))
#:make-flags
(list "CC=gcc" (string-append "prefix?=" (assoc-ref %outputs "out")))))
(inputs `(("git" ,git)))
(native-inputs `(("asciidoc" ,asciidoc)
("docbook-xml" ,docbook-xml)
("docbook-xsl" ,docbook-xsl)
("xmllint" ,libxml2)
("xsltproc" ,libxslt)
;; These are needed for the tests.
("cvs" ,cvs)
("python" ,python-2)
("rcs" ,rcs)))
(home-page "http://www.catb.org/esr/cvs-fast-export/")
(synopsis "Export an RCS or CVS history as a fast-import stream")
(description "This program analyzes a collection of RCS files in a CVS
repository (or outside of one) and, when possible, emits an equivalent history
in the form of a fast-import stream. Not all possible histories can be
rendered this way; the program tries to emit useful warnings when it can't.
The program can also produce a visualization of the resulting commit directed
acyclic graph (DAG) in the input format of @uref{http://www.graphviz.org,
Graphviz}. The package also includes @command{cvssync}, a tool for mirroring
masters from remote CVS hosts.")
(license gpl2+)))
(define-public vc-dwim
(package
(name "vc-dwim")

2
gnu/packages/vpn.scm
View file

@ -63,7 +63,7 @@ (define-public vpnc
(version "0.5.3")
(source (origin
(method url-fetch)
(uri (string-append "http://www.unix-ag.uni-kl.de/~massar/vpnc/vpnc-"
(uri (string-append "https://www.unix-ag.uni-kl.de/~massar/vpnc/vpnc-"
version ".tar.gz"))
(sha256 (base32
"1128860lis89g1s21hqxvap2nq426c9j4bvgghncc1zj0ays7kj6"))

30
gnu/system.scm
View file

@ -83,6 +83,11 @@ (define-module (gnu system)
operating-system-derivation
operating-system-profile
operating-system-grub.cfg
operating-system-etc-directory
operating-system-locale-directory
operating-system-boot-script
file-union
local-host-aliases
%setuid-programs
@ -689,7 +694,7 @@ (define (modprobe-wrapper)
(apply execl #$modprobe
(cons #$modprobe (cdr (command-line))))))))
(define (operating-system-activation-script os)
(define* (operating-system-activation-script os #:key container?)
"Return the activation script for OS---i.e., the code that \"activates\" the
stateful part of OS, including user accounts and groups, special directories,
etc."
@ -763,12 +768,15 @@ (define group-specs
;; Tell the kernel to use our 'modprobe' command.
(activate-modprobe #$modprobe)
;; Tell the kernel where firmware is.
(activate-firmware
(string-append #$firmware "/lib/firmware"))
;; Let users debug their own processes!
(activate-ptrace-attach)
;; Tell the kernel where firmware is, unless we are
;; activating a container.
#$@(if container?
#~()
;; Tell the kernel where firmware is.
#~((activate-firmware
(string-append #$firmware "/lib/firmware"))
;; Let users debug their own processes!
(activate-ptrace-attach)))
;; Run the services' activation snippets.
;; TODO: Use 'load-compiled'.
@ -777,11 +785,13 @@ (define group-specs
;; Set up /run/current-system.
(activate-current-system)))))
(define (operating-system-boot-script os)
(define* (operating-system-boot-script os #:key container?)
"Return the boot script for OS---i.e., the code started by the initrd once
we're running in the final root."
we're running in the final root. When CONTAINER? is true, skip all
hardware-related operations as necessary when booting a Linux container."
(mlet* %store-monad ((services (operating-system-services os))
(activate (operating-system-activation-script os))
(activate (operating-system-activation-script
os #:container? container?))
(dmd-conf (dmd-configuration-file services)))
(gexp->file "boot"
#~(begin

15
gnu/system/file-systems.scm
View file

@ -47,7 +47,6 @@ (define-module (gnu system file-systems)
%binary-format-file-system
%shared-memory-file-system
%pseudo-terminal-file-system
%devtmpfs-file-system
%immutable-store
%control-groups
%elogind-file-systems
@ -186,17 +185,6 @@ (define %binary-format-file-system
(type "binfmt_misc")
(check? #f)))
(define %devtmpfs-file-system
;; /dev as a 'devtmpfs' file system, needed for udev.
(file-system
(device "none")
(mount-point "/dev")
(type "devtmpfs")
(check? #f)
;; Mount it from the initrd so /dev/pts & co. can then be mounted over it.
(needed-for-boot? #t)))
(define %tty-gid
;; ID of the 'tty' group. Allocate it statically to make it easy to refer
;; to it from here and from the 'tty' group definitions.
@ -282,8 +270,7 @@ (define %elogind-file-systems
(define %base-file-systems
;; List of basic file systems to be mounted. Note that /proc and /sys are
;; currently mounted by the initrd.
(append (list %devtmpfs-file-system
%pseudo-terminal-file-system
(append (list %pseudo-terminal-file-system
%shared-memory-file-system
%immutable-store)
%elogind-file-systems

119
gnu/system/linux-container.scm Normal file
View file

@ -0,0 +1,119 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu system linux-container)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (guix config)
#:use-module (guix store)
#:use-module (guix gexp)
#:use-module (guix derivations)
#:use-module (guix monads)
#:use-module (gnu build linux-container)
#:use-module (gnu system)
#:use-module (gnu system file-systems)
#:export (mapping->file-system
system-container
containerized-operating-system
container-script))
(define (mapping->file-system mapping)
"Return a file system that realizes MAPPING."
(match mapping
(($ <file-system-mapping> source target writable?)
(file-system
(mount-point target)
(device source)
(type "none")
(flags (if writable?
'(bind-mount)
'(bind-mount read-only)))
(check? #f)
(create-mount-point? #t)))))
(define (system-container os)
"Return a derivation that builds OS as a Linux container."
(mlet* %store-monad
((profile (operating-system-profile os))
(etc (operating-system-etc-directory os))
(boot (operating-system-boot-script os #:container? #t))
(locale (operating-system-locale-directory os)))
(file-union "system-container"
`(("boot" ,#~#$boot)
("profile" ,#~#$profile)
("locale" ,#~#$locale)
("etc" ,#~#$etc)))))
(define (containerized-operating-system os mappings)
"Return an operating system based on OS for use in a Linux container
environment. MAPPINGS is a list of <file-system-mapping> to realize in the
containerized OS."
(define user-file-systems
(remove (lambda (fs)
(let ((target (file-system-mount-point fs))
(source (file-system-device fs)))
(or (string=? target (%store-prefix))
(string=? target "/")
(string-prefix? "/dev/" source)
(string-prefix? "/dev" target)
(string-prefix? "/sys" target))))
(operating-system-file-systems os)))
(define (mapping->fs fs)
(file-system (inherit (mapping->file-system fs))
(needed-for-boot? #t)))
(operating-system (inherit os)
(swap-devices '()) ; disable swap
(file-systems (append (map mapping->fs (cons %store-mapping mappings))
%container-file-systems
user-file-systems))))
(define* (container-script os #:key (mappings '()))
"Return a derivation of a script that runs OS as a Linux container.
MAPPINGS is a list of <file-system> objects that specify the files/directories
that will be shared with the host system."
(let* ((os (containerized-operating-system os mappings))
(file-systems (filter file-system-needed-for-boot?
(operating-system-file-systems os)))
(specs (map file-system->spec file-systems)))
(mlet* %store-monad ((os-drv (system-container os)))
(define script
#~(begin
(use-modules (gnu build linux-container)
(guix build utils))
(call-with-container '#$specs
(lambda ()
(setenv "HOME" "/root")
(setenv "TMPDIR" "/tmp")
(setenv "GUIX_NEW_SYSTEM" #$os-drv)
(for-each mkdir-p '("/run" "/bin" "/etc" "/home" "/var"))
(primitive-load (string-append #$os-drv "/boot"))))))
(gexp->script "run-container" script
#:modules '((ice-9 match)
(srfi srfi-98)
(guix config)
(guix utils)
(guix build utils)
(guix build syscalls)
(gnu build file-systems)
(gnu build linux-container))))))

1
gnu/system/linux-initrd.scm
View file

@ -182,6 +182,7 @@ (define linux-modules
"isci" ;for SAS controllers like Intel C602
"usb-storage" "uas" ;for the installation image etc.
"usbkbd" "usbhid" ;USB keyboards, for debugging
"dm-crypt" "xts" ;for encrypted root partitions
,@(if (or virtio? qemu-networking?)
virtio-modules
'())

12
guix/build-system/r.scm
View file

@ -28,7 +28,8 @@ (define-module (guix build-system r)
#:use-module (srfi srfi-26)
#:export (%r-build-system-modules
r-build
r-build-system))
r-build-system
cran-uri))
;; Commentary:
;;
@ -36,6 +37,15 @@ (define-module (guix build-system r)
;;
;; Code:
(define (cran-uri name version)
"Return a list of URI strings for the R package archive on CRAN for the
release corresponding to NAME and VERSION. As only the most recent version is
available via the first URI, the second URI points to the archived version."
(list (string-append "mirror://cran/src/contrib/"
name "_" version ".tar.gz")
(string-append "mirror://cran/src/contrib/Archive/"
name "/" name "_" version ".tar.gz")))
(define %r-build-system-modules
;; Build-side modules imported by default.
`((guix build r-build-system)

83
guix/build/download.scm
View file

@ -36,8 +36,10 @@ (define-module (guix build download)
resolve-uri-reference
maybe-expand-mirrors
url-fetch
byte-count->string
progress-proc
uri-abbreviation))
uri-abbreviation
store-path-abbreviation))
;;; Commentary:
;;;
@ -49,6 +51,11 @@ (define %http-receive-buffer-size
;; Size of the HTTP receive buffer.
65536)
(define (nearest-exact-integer x)
"Given a real number X, return the nearest exact integer, with ties going to
the nearest exact even integer."
(inexact->exact (round x)))
(define (duration->seconds duration)
"Return the number of seconds represented by DURATION, a 'time-duration'
object, as an inexact number."
@ -56,16 +63,17 @@ (define (duration->seconds duration)
(/ (time-nanosecond duration) 1e9)))
(define (seconds->string duration)
"Given DURATION in seconds, return a string representing it in 'hh:mm:ss'
format."
"Given DURATION in seconds, return a string representing it in 'mm:ss' or
'hh:mm:ss' format, as needed."
(if (not (number? duration))
"00:00:00"
(let* ((total-seconds (inexact->exact (round duration)))
"00:00"
(let* ((total-seconds (nearest-exact-integer duration))
(extra-seconds (modulo total-seconds 3600))
(hours (quotient total-seconds 3600))
(num-hours (quotient total-seconds 3600))
(hours (and (positive? num-hours) num-hours))
(mins (quotient extra-seconds 60))
(secs (modulo extra-seconds 60)))
(format #f "~2,'0d:~2,'0d:~2,'0d" hours mins secs))))
(format #f "~@[~2,'0d:~]~2,'0d:~2,'0d" hours mins secs))))
(define (byte-count->string size)
"Given SIZE in bytes, return a string representing it in a human-readable
@ -75,8 +83,8 @@ (define (byte-count->string size)
(GiB (expt 1024. 3))
(TiB (expt 1024. 4)))
(cond
((< size KiB) (format #f "~dB" (inexact->exact size)))
((< size MiB) (format #f "~dKiB" (inexact->exact (round (/ size KiB)))))
((< size KiB) (format #f "~dB" (nearest-exact-integer size)))
((< size MiB) (format #f "~dKiB" (nearest-exact-integer (/ size KiB))))
((< size GiB) (format #f "~,1fMiB" (/ size MiB)))
((< size TiB) (format #f "~,2fGiB" (/ size GiB)))
(else (format #f "~,3fTiB" (/ size TiB))))))
@ -91,10 +99,33 @@ (define* (progress-bar % #:optional (bar-width 20))
(make-string filled #\#)
(make-string empty #\space))))
(define* (progress-proc file size #:optional (log-port (current-output-port)))
(define (string-pad-middle left right len)
"Combine LEFT and RIGHT with enough padding in the middle so that the
resulting string has length at least LEN. This right justifies RIGHT."
(string-append left
(string-pad right (max 0 (- len (string-length left))))))
(define (store-url-abbreviation url)
"Return a friendlier version of URL for display."
(let ((store-path (string-append (%store-directory) "/" (basename url))))
;; Take advantage of the implementation for store paths.
(store-path-abbreviation store-path)))
(define* (store-path-abbreviation store-path #:optional (prefix-length 6))
"Return an abbreviation of STORE-PATH for display, showing PREFIX-LENGTH
characters of the hash."
(let ((base (basename store-path)))
(string-append (string-take base prefix-length)
"…"
(string-drop base 32))))
(define* (progress-proc file size
#:optional (log-port (current-output-port))
#:key (abbreviation identity))
"Return a procedure to show the progress of FILE's download, which is SIZE
bytes long. The returned procedure is suitable for use as an argument to
`dump-port'. The progress report is written to LOG-PORT."
`dump-port'. The progress report is written to LOG-PORT, with ABBREVIATION
used to shorten FILE for display."
;; XXX: Because of <http://bugs.gnu.org/19939> this procedure is often not
;; called as frequently as we'd like too; this is especially bad with Nginx
;; on hydra.gnu.org, which returns whole nars as a single chunk.
@ -118,31 +149,31 @@ (define* (progress-proc file size #:optional (log-port (current-output-port)))
(/ transferred elapsed)
0))
(left (format #f " ~a ~a"
(basename file)
(abbreviation file)
(byte-count->string size)))
(right (format #f "~a/s ~a ~a~6,1f%"
(byte-count->string throughput)
(seconds->string elapsed)
(progress-bar %) %))
;; TODO: Make this adapt to the actual terminal width.
(cols 80)
(num-spaces (max 1 (- cols (+ (string-length left)
(string-length right)))))
(gap (make-string num-spaces #\space)))
(format log-port "~a~a~a" left gap right)
(progress-bar %) %)))
;; TODO: Make this adapt to the actual terminal width.
(display (string-pad-middle left right 80) log-port)
(display #\cr log-port)
(flush-output-port log-port)
(cont))))
(lambda (transferred cont)
(with-elapsed-time elapsed
(let ((throughput (if elapsed
(/ transferred elapsed)
0)))
(let* ((throughput (if elapsed
(/ transferred elapsed)
0))
(left (format #f " ~a"
(abbreviation file)))
(right (format #f "~a/s ~a | ~a transferred"
(byte-count->string throughput)
(seconds->string elapsed)
(byte-count->string transferred))))
;; TODO: Make this adapt to the actual terminal width.
(display (string-pad-middle left right 80) log-port)
(display #\cr log-port)
(format log-port "~a\t~a transferred (~a/s)"
file
(byte-count->string transferred)
(byte-count->string throughput))
(flush-output-port log-port)
(cont))))))))

80
guix/build/ruby-build-system.scm
View file

@ -41,53 +41,63 @@ (define (first-matching-file pattern)
((file-name . _) file-name)
(() (error "No files matching pattern: " pattern))))
(define gnu:unpack (assq-ref gnu:%standard-phases 'unpack))
(define (gem-archive? file-name)
(string-match "^.*\\.gem$" file-name))
(define* (unpack #:key source #:allow-other-keys)
"Unpack the gem SOURCE and enter the resulting directory."
(and (zero? (system* "gem" "unpack" source))
;; The unpacked gem directory is named the same as the archive, sans
;; the ".gem" extension. It is renamed to simply "gem" in an effort to
;; keep file names shorter to avoid UNIX-domain socket file names and
;; shebangs that exceed the system's fixed maximum length when running
;; test suites.
(let ((dir (match:substring (string-match "^(.*)\\.gem$"
(basename source))
1)))
(rename-file dir "gem")
(chdir "gem")
#t)))
(if (gem-archive? source)
(and (zero? (system* "gem" "unpack" source))
;; The unpacked gem directory is named the same as the archive,
;; sans the ".gem" extension. It is renamed to simply "gem" in an
;; effort to keep file names shorter to avoid UNIX-domain socket
;; file names and shebangs that exceed the system's fixed maximum
;; length when running test suites.
(let ((dir (match:substring (string-match "^(.*)\\.gem$"
(basename source))
1)))
(rename-file dir "gem")
(chdir "gem")
#t))
;; Use GNU unpack strategy for things that aren't gem archives.
(gnu:unpack #:source source)))
(define* (build #:key source #:allow-other-keys)
"Build a new gem using the gemspec from the SOURCE gem."
(define (first-gemspec)
(first-matching-file "\\.gemspec$"))
;; Remove the original gemspec, if present, and replace it with a new one.
;; This avoids issues with upstream gemspecs requiring tools such as git to
;; generate the files list.
(let ((gemspec (or (false-if-exception
(first-matching-file "\\.gemspec$"))
;; Make new gemspec if one wasn't shipped.
".gemspec")))
(when (gem-archive? source)
(let ((gemspec (or (false-if-exception (first-gemspec))
;; Make new gemspec if one wasn't shipped.
".gemspec")))
(when (file-exists? gemspec) (delete-file gemspec))
(when (file-exists? gemspec) (delete-file gemspec))
;; Extract gemspec from source gem.
(let ((pipe (open-pipe* OPEN_READ "gem" "spec" "--ruby" source)))
(dynamic-wind
(const #t)
(lambda ()
(call-with-output-file gemspec
(lambda (out)
;; 'gem spec' writes to stdout, but 'gem build' only reads
;; gemspecs from a file, so we redirect the output to a file.
(while (not (eof-object? (peek-char pipe)))
(write-char (read-char pipe) out))))
#t)
(lambda ()
(close-pipe pipe))))
;; Extract gemspec from source gem.
(let ((pipe (open-pipe* OPEN_READ "gem" "spec" "--ruby" source)))
(dynamic-wind
(const #t)
(lambda ()
(call-with-output-file gemspec
(lambda (out)
;; 'gem spec' writes to stdout, but 'gem build' only reads
;; gemspecs from a file, so we redirect the output to a file.
(while (not (eof-object? (peek-char pipe)))
(write-char (read-char pipe) out))))
#t)
(lambda ()
(close-pipe pipe))))))
;; Build a new gem from the current working directory. This also allows any
;; dynamic patching done in previous phases to be present in the installed
;; gem.
(zero? (system* "gem" "build" gemspec))))
;; Build a new gem from the current working directory. This also allows any
;; dynamic patching done in previous phases to be present in the installed
;; gem.
(zero? (system* "gem" "build" (first-gemspec))))
(define* (check #:key tests? test-target #:allow-other-keys)
"Run the gem's test suite rake task TEST-TARGET. Skip the tests if TESTS?

2
guix/download.scm
View file

@ -167,9 +167,9 @@ (define %mirrors
(cran
;; Arbitrary mirrors from http://cran.r-project.org/mirrors.html
;; This one automatically redirects to servers worldwide
"http://cran.r-project.org/"
"http://cran.rstudio.com/"
"http://cran.univ-lyon1.fr/"
"http://cran.r-mirror.de/"
"http://cran.ism.ac.jp/"
"http://cran.stat.auckland.ac.nz/"
"http://cran.mirror.ac.za/"

2
guix/import/cran.scm
View file

@ -165,7 +165,7 @@ (define (guix-name name)
(version ,version)
(source (origin
(method url-fetch)
(uri (string-append ,@(factorize-uri source-url version)))
(uri (cran-uri ,name version))
(sha256
(base32
,(bytevector->nix-base32-string (file-sha256 tarball))))))

6
guix/licenses.scm
View file

@ -61,6 +61,7 @@ (define-module (guix licenses)
sleepycat
vim
x11 x11-style
zpl2.1
zlib
fsf-free))
@ -382,6 +383,11 @@ (define* (x11-style uri #:optional (comment ""))
"Check the URI for details. "
comment)))
(define zpl2.1
(license "Zope Public License 2.1"
"http://directory.fsf.org/wiki?title=License:ZopePLv2.1"
"https://www.gnu.org/licenses/license-list.html#Zope2.0"))
(define zlib
(license "Zlib"
"http://www.gzip.org/zlib/zlib_license.html"

22
guix/packages.scm
View file

@ -37,6 +37,7 @@ (define-module (guix packages)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (web uri)
#:re-export (%current-system
%current-target-system
search-path-specification) ;for convenience
@ -46,6 +47,7 @@ (define-module (guix packages)
origin-method
origin-sha256
origin-file-name
origin-actual-file-name
origin-patches
origin-patch-flags
origin-patch-inputs
@ -189,6 +191,26 @@ (define-syntax base32
((_ str)
#'(nix-base32-string->bytevector str)))))
(define (origin-actual-file-name origin)
"Return the file name of ORIGIN, either its 'file-name' field or the file
name of its URI."
(define (uri->file-name uri)
;; Return the 'base name' of URI or URI itself, where URI is a string.
(let ((path (and=> (string->uri uri) uri-path)))
(if path
(basename path)
uri)))
(or (origin-file-name origin)
(match (origin-uri origin)
((head . tail)
(uri->file-name head))
((? string? uri)
(uri->file-name uri))
(else
;; git, svn, cvs, etc. reference
#f))))
(define %supported-systems
;; This is the list of system types that are supported. By default, we
;; expect all packages to build successfully here.

118
guix/scripts.scm Normal file
View file

@ -0,0 +1,118 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Deck Pickard <deck.r.pickard@gmail.com>
;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix scripts)
#:use-module (guix utils)
#:use-module (guix ui)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-37)
#:use-module (ice-9 match)
#:export (args-fold*
parse-command-line
maybe-build
build-package))
;;; Commentary:
;;;
;;; General code for Guix scripts.
;;;
;;; Code:
(define (args-fold* options unrecognized-option-proc operand-proc . seeds)
"A wrapper on top of `args-fold' that does proper user-facing error
reporting."
(catch 'misc-error
(lambda ()
(apply args-fold options unrecognized-option-proc
operand-proc seeds))
(lambda (key proc msg args . rest)
;; XXX: MSG is not i18n'd.
(leave (_ "invalid argument: ~a~%")
(apply format #f msg args)))))
(define (environment-build-options)
"Return additional build options passed as environment variables."
(arguments-from-environment-variable "GUIX_BUILD_OPTIONS"))
(define %default-argument-handler
;; The default handler for non-option command-line arguments.
(lambda (arg result)
(alist-cons 'argument arg result)))
(define* (parse-command-line args options seeds
#:key
(argument-handler %default-argument-handler))
"Parse the command-line arguments ARGS as well as arguments passed via the
'GUIX_BUILD_OPTIONS' environment variable according to OPTIONS (a list of
SRFI-37 options) and return the result, seeded by SEEDS.
Command-line options take precedence those passed via 'GUIX_BUILD_OPTIONS'.
ARGUMENT-HANDLER is called for non-option arguments, like the 'operand-proc'
parameter of 'args-fold'."
(define (parse-options-from args seeds)
;; Actual parsing takes place here.
(apply args-fold* args options
(lambda (opt name arg . rest)
(leave (_ "~A: unrecognized option~%") name))
argument-handler
seeds))
(call-with-values
(lambda ()
(parse-options-from (environment-build-options) seeds))
(lambda seeds
;; ARGS take precedence over what the environment variable specifies.
(parse-options-from args seeds))))
(define* (maybe-build drvs
#:key dry-run? use-substitutes?)
"Show what will/would be built, and actually build DRVS, unless DRY-RUN? is
true."
(with-monad %store-monad
(>>= (show-what-to-build* drvs
#:dry-run? dry-run?
#:use-substitutes? use-substitutes?)
(lambda (_)
(if dry-run?
(return #f)
(built-derivations drvs))))))
(define* (build-package package
#:key dry-run? (use-substitutes? #t)
#:allow-other-keys
#:rest build-options)
"Build PACKAGE using BUILD-OPTIONS acceptable by 'set-build-options'.
Show what and how will/would be built."
(mbegin %store-monad
(apply set-build-options*
#:use-substitutes? use-substitutes?
(strip-keyword-arguments '(#:dry-run?) build-options))
(mlet %store-monad ((derivation (package->derivation package)))
(mbegin %store-monad
(maybe-build (list derivation)
#:use-substitutes? use-substitutes?
#:dry-run? dry-run?)
(return (show-derivation-outputs derivation))))))
;;; scripts.scm ends here

1
guix/scripts/archive.scm
View file

@ -27,6 +27,7 @@ (define-module (guix scripts archive)
#:use-module (guix ui)
#:use-module (guix pki)
#:use-module (guix pk-crypto)
#:use-module (guix scripts)
#:use-module (guix scripts build)
#:use-module (gnu packages)
#:use-module (ice-9 match)

10
guix/scripts/build.scm
View file

@ -19,6 +19,7 @@
(define-module (guix scripts build)
#:use-module (guix ui)
#:use-module (guix scripts)
#:use-module (guix store)
#:use-module (guix derivations)
#:use-module (guix packages)
@ -537,14 +538,7 @@ (define (guix-build . args)
roots))
((not (assoc-ref opts 'dry-run?))
(and (build-derivations store drv)
(for-each (lambda (d)
(format #t "~{~a~%~}"
(map (match-lambda
((out-name . out)
(derivation->output-path
d out-name)))
(derivation-outputs d))))
drv)
(for-each show-derivation-outputs drv)
(for-each (cut register-root store <> <>)
(map (lambda (drv)
(map cdr

1
guix/scripts/download.scm
View file

@ -18,6 +18,7 @@
(define-module (guix scripts download)
#:use-module (guix ui)
#:use-module (guix scripts)
#:use-module (guix store)
#:use-module (guix hash)
#:use-module (guix utils)

1
guix/scripts/edit.scm
View file

@ -18,6 +18,7 @@
(define-module (guix scripts edit)
#:use-module (guix ui)
#:use-module (guix scripts)
#:use-module (guix utils)
#:use-module (guix packages)
#:use-module (gnu packages)

1
guix/scripts/environment.scm
View file

@ -27,6 +27,7 @@ (define-module (guix scripts environment)
#:use-module (guix utils)
#:use-module (guix monads)
#:use-module ((guix gexp) #:select (lower-inputs))
#:use-module (guix scripts)
#:use-module (guix scripts build)
#:use-module (gnu packages)
#:use-module (ice-9 format)

1
guix/scripts/gc.scm
View file

@ -18,6 +18,7 @@
(define-module (guix scripts gc)
#:use-module (guix ui)
#:use-module (guix scripts)
#:use-module (guix store)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)

16
guix/scripts/graph.scm
View file

@ -18,6 +18,7 @@
(define-module (guix scripts graph)
#:use-module (guix ui)
#:use-module (guix scripts)
#:use-module (guix utils)
#:use-module (guix packages)
#:use-module (guix monads)
@ -33,7 +34,6 @@ (define-module (guix scripts graph)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-37)
#:use-module (ice-9 match)
#:use-module (web uri)
#:export (%package-node-type
%bag-node-type
%bag-emerged-node-type
@ -78,25 +78,13 @@ (define-record-type* <node-type> node-type make-node-type
;;; Package DAG.
;;;
(define (uri->file-name uri)
"Return the 'base name' of URI or URI itself, where URI is a string."
(let ((path (and=> (string->uri uri) uri-path)))
(if path
(basename path)
uri)))
(define (node-full-name thing)
"Return a human-readable name to denote THING, a package, origin, or file
name."
(cond ((package? thing)
(package-full-name thing))
((origin? thing)
(or (origin-file-name thing)
(match (origin-uri thing)
((head . tail)
(uri->file-name head))
((? string? uri)
(uri->file-name uri)))))
(origin-actual-file-name thing))
((string? thing) ;file name
(or (basename thing)
(error "basename" thing)))

1
guix/scripts/hash.scm
View file

@ -22,6 +22,7 @@ (define-module (guix scripts hash)
#:use-module (guix hash)
#:use-module (guix serialization)
#:use-module (guix ui)
#:use-module (guix scripts)
#:use-module (guix utils)
#:use-module (rnrs io ports)
#:use-module (rnrs files)

1
guix/scripts/import/cpan.scm
View file

@ -19,6 +19,7 @@
(define-module (guix scripts import cpan)
#:use-module (guix ui)
#:use-module (guix utils)
#:use-module (guix scripts)
#:use-module (guix import cpan)
#:use-module (guix scripts import)
#:use-module (srfi srfi-1)

1
guix/scripts/import/cran.scm
View file

@ -20,6 +20,7 @@
(define-module (guix scripts import cran)
#:use-module (guix ui)
#:use-module (guix utils)
#:use-module (guix scripts)
#:use-module (guix import cran)
#:use-module (guix scripts import)
#:use-module (srfi srfi-1)

1
guix/scripts/import/elpa.scm
View file

@ -19,6 +19,7 @@
(define-module (guix scripts import elpa)
#:use-module (guix ui)
#:use-module (guix utils)
#:use-module (guix scripts)
#:use-module (guix import elpa)
#:use-module (guix scripts import)
#:use-module (srfi srfi-1)

1
guix/scripts/import/gem.scm
View file

@ -19,6 +19,7 @@
(define-module (guix scripts import gem)
#:use-module (guix ui)
#:use-module (guix utils)
#:use-module (guix scripts)
#:use-module (guix import gem)
#:use-module (guix scripts import)
#:use-module (srfi srfi-1)

1
guix/scripts/import/gnu.scm
View file

@ -19,6 +19,7 @@
(define-module (guix scripts import gnu)
#:use-module (guix ui)
#:use-module (guix utils)
#:use-module (guix scripts)
#:use-module (guix import gnu)
#:use-module (guix scripts import)
#:use-module (srfi srfi-1)

3
guix/scripts/import/hackage.scm
View file

@ -19,6 +19,7 @@
(define-module (guix scripts import hackage)
#:use-module (guix ui)
#:use-module (guix utils)
#:use-module (guix scripts)
#:use-module (guix import hackage)
#:use-module (guix scripts import)
#:use-module (srfi srfi-1)
@ -47,7 +48,7 @@ (define (show-help)
generated package definition will correspond to the latest available
version.\n"))
(display (_ "
-e ALIST, --cabal-environment=ALIST
-e ALIST, --cabal-environment=ALIST
specify environment for Cabal evaluation"))
(display (_ "
-h, --help display this help and exit"))

1
guix/scripts/import/nix.scm
View file

@ -20,6 +20,7 @@
(define-module (guix scripts import nix)
#:use-module (guix ui)
#:use-module (guix utils)
#:use-module (guix scripts)
#:use-module (guix import snix)
#:use-module (guix scripts import)
#:use-module (srfi srfi-1)

1
guix/scripts/import/pypi.scm
View file

@ -19,6 +19,7 @@
(define-module (guix scripts import pypi)
#:use-module (guix ui)
#:use-module (guix utils)
#:use-module (guix scripts)
#:use-module (guix import pypi)
#:use-module (guix scripts import)
#:use-module (srfi srfi-1)

52
guix/scripts/lint.scm
View file

@ -1,7 +1,8 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2014, 2015 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -28,6 +29,7 @@ (define-module (guix scripts lint)
#:use-module (guix records)
#:use-module (guix ui)
#:use-module (guix utils)
#:use-module (guix scripts)
#:use-module (guix gnu-maintenance)
#:use-module (guix monads)
#:use-module (gnu packages)
@ -57,6 +59,7 @@ (define-module (guix scripts lint)
check-derivation
check-home-page
check-source
check-source-file-name
check-license
check-formatting
@ -140,6 +143,13 @@ (define (check-not-empty description)
(_ "description should not be empty")
'description)))
(define (check-texinfo-markup package)
"Check that PACKAGE description can be parsed as a Texinfo fragment."
(catch 'parser-error
(lambda () (package-description-string package))
(lambda (keys . args)
(emit-warning package (_ "Texinfo markup in description is invalid")))))
(define (check-proper-start description)
(unless (or (properly-starts-sentence? description)
(string-prefix-ci? (package-name package) description))
@ -169,6 +179,7 @@ (define (check-end-of-sentence-space description)
(let ((description (package-description package)))
(when (string? description)
(check-not-empty description)
(check-texinfo-markup package)
(check-proper-start description)
(check-end-of-sentence-space description))))
@ -501,6 +512,26 @@ (define (try-uris uris)
(display warning (guix-warning-port)))
(reverse warnings)))))))))
(define (check-source-file-name package)
"Emit a warning if PACKAGE's origin has no meaningful file name."
(define (origin-file-name-valid? origin)
;; Return #t if the source file name contains only a version or is #f;
;; indicates that the origin needs a 'file-name' field.
(let ((file-name (origin-actual-file-name origin))
(version (package-version package)))
(and file-name
(not (or (string-prefix? version file-name)
;; Common in many projects is for the filename to start
;; with a "v" followed by the version,
;; e.g. "v3.2.0.tar.gz".
(string-prefix? (string-append "v" version) file-name))))))
(let ((origin (package-source package)))
(unless (or (not origin) (origin-file-name-valid? origin))
(emit-warning package
(_ "the source file name should contain the package name")
'source))))
(define (check-derivation package)
"Emit a warning if we fail to compile PACKAGE to a derivation."
(catch #t
@ -563,12 +594,25 @@ (define (report-long-line package line line-number)
(format #f (_ "line ~a is way too long (~a characters)")
line-number (string-length line)))))
(define %hanging-paren-rx
(make-regexp "^[[:blank:]]*[()]+[[:blank:]]*$"))
(define (report-lone-parentheses package line line-number)
"Emit a warning if LINE contains hanging parentheses."
(when (regexp-exec %hanging-paren-rx line)
(emit-warning package
(format #f
(_ "line ~a: parentheses feel lonely, \
move to the previous or next line")
line-number))))
(define %formatting-reporters
;; List of procedures that report formatting issues. These are not separate
;; checkers because they would need to re-read the file.
(list report-tabulations
report-trailing-white-space
report-long-line))
report-long-line
report-lone-parentheses))
(define* (report-formatting-issues package file starting-line
#:key (reporters %formatting-reporters))
@ -642,6 +686,10 @@ (define %checkers
(name 'source)
(description "Validate source URLs")
(check check-source))
(lint-checker
(name 'source-file-name)
(description "Validate file names of sources")
(check check-source-file-name))
(lint-checker
(name 'derivation)
(description "Report failure to compile a package to a derivation")

1
guix/scripts/package.scm
View file

@ -29,6 +29,7 @@ (define-module (guix scripts package)
#:use-module (guix monads)
#:use-module (guix utils)
#:use-module (guix config)
#:use-module (guix scripts)
#:use-module (guix scripts build)
#:use-module ((guix build utils)
#:select (directory-exists? mkdir-p search-path-as-list))

1
guix/scripts/publish.scm
View file

@ -45,6 +45,7 @@ (define-module (guix scripts publish)
#:use-module (guix store)
#:use-module (guix serialization)
#:use-module (guix ui)
#:use-module (guix scripts)
#:export (guix-publish))
(define (show-help)

1
guix/scripts/pull.scm
View file

@ -18,6 +18,7 @@
(define-module (guix scripts pull)
#:use-module (guix ui)
#:use-module (guix scripts)
#:use-module (guix store)
#:use-module (guix config)
#:use-module (guix packages)

1
guix/scripts/refresh.scm
View file

@ -21,6 +21,7 @@
(define-module (guix scripts refresh)
#:use-module (guix ui)
#:use-module (guix hash)
#:use-module (guix scripts)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix packages)

1
guix/scripts/size.scm
View file

@ -18,6 +18,7 @@
(define-module (guix scripts size)
#:use-module (guix ui)
#:use-module (guix scripts)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix utils)

17
guix/scripts/substitute.scm
View file

@ -31,7 +31,8 @@ (define-module (guix scripts substitute)
#:use-module (guix pki)
#:use-module ((guix build utils) #:select (mkdir-p dump-port))
#:use-module ((guix build download)
#:select (progress-proc uri-abbreviation))
#:select (progress-proc uri-abbreviation
store-path-abbreviation byte-count->string))
#:use-module (ice-9 rdelim)
#:use-module (ice-9 regex)
#:use-module (ice-9 match)
@ -337,8 +338,9 @@ (define* (assert-valid-narinfo narinfo
(unless %allow-unauthenticated-substitutes?
(assert-valid-signature narinfo signature hash acl)
(when verbose?
;; Visually separate substitutions with a newline.
(format (current-error-port)
"found valid signature for '~a', from '~a'~%"
"~%Found valid signature for ~a~%From ~a~%"
(narinfo-path narinfo)
(uri->string (narinfo-uri narinfo)))))
narinfo))))
@ -753,13 +755,12 @@ (define* (process-substitution store-item destination
;; Tell the daemon what the expected hash of the Nar itself is.
(format #t "~a~%" (narinfo-hash narinfo))
(format (current-error-port) "downloading `~a'~:[~*~; (~,1f MiB installed)~]...~%"
store-item
(format (current-error-port) "Downloading ~a~:[~*~; (~a installed)~]...~%"
(store-path-abbreviation store-item)
;; Use the Nar size as an estimate of the installed size.
(narinfo-size narinfo)
(and=> (narinfo-size narinfo)
(cute / <> (expt 2. 20))))
(cute byte-count->string <>)))
(let*-values (((raw download-size)
;; Note that Hydra currently generates Nars on the fly
;; and doesn't specify a Content-Length, so
@ -772,7 +773,9 @@ (define* (process-substitution store-item destination
(narinfo-size narinfo))))
(progress (progress-proc (uri-abbreviation uri)
dl-size
(current-error-port))))
(current-error-port)
#:abbreviation
store-path-abbreviation)))
(progress-report-port progress raw)))
((input pids)
(decompressed-port (and=> (narinfo-compression narinfo)

21
guix/scripts/system.scm
View file

@ -26,6 +26,7 @@ (define-module (guix scripts system)
#:use-module (guix utils)
#:use-module (guix monads)
#:use-module (guix profiles)
#:use-module (guix scripts)
#:use-module (guix scripts build)
#:use-module (guix build utils)
#:use-module (gnu build install)
@ -298,19 +299,6 @@ (define* (system-derivation-for-action os action
((disk-image)
(system-disk-image os #:disk-image-size image-size))))
(define* (maybe-build drvs
#:key dry-run? use-substitutes?)
"Show what will/would be built, and actually build DRVS, unless DRY-RUN? is
true."
(with-monad %store-monad
(>>= (show-what-to-build* drvs
#:dry-run? dry-run?
#:use-substitutes? use-substitutes?)
(lambda (_)
(if dry-run?
(return #f)
(built-derivations drvs))))))
(define* (perform-action action os
#:key grub? dry-run?
use-substitutes? device target
@ -514,6 +502,13 @@ (define (fail)
(leave (_ "wrong number of arguments for action '~a'~%")
action))
(unless action
(format (current-error-port)
(_ "guix system: missing command name~%"))
(format (current-error-port)
(_ "Try 'guix system --help' for more information.~%"))
(exit 1))
(case action
((build vm vm-image disk-image reconfigure)
(unless (= count 1)

4
guix/store.scm
View file

@ -58,6 +58,7 @@ (define-module (guix store)
close-connection
with-store
set-build-options
set-build-options*
valid-path?
query-path-hash
hash-part->path
@ -986,6 +987,9 @@ (define build
;; Monadic variant of 'build-things'.
(store-lift build-things))
(define set-build-options*
(store-lift set-build-options))
(define %guile-for-build
;; The derivation of the Guile to be used within the build environment,
;; when using 'gexp->derivation' and co.

62
guix/ui.scm
View file

@ -2,9 +2,11 @@
;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2014 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2014 Cyrill Schenkel <cyrill.schenkel@gmail.com>
;;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org>
;;; Copyright © 2014 Deck Pickard <deck.r.pickard@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -39,7 +41,6 @@ (define-module (guix ui)
#:use-module (srfi srfi-31)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (srfi srfi-37)
#:autoload (ice-9 ftw) (scandir)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
@ -61,6 +62,7 @@ (define-module (guix ui)
show-bug-report-information
string->number*
size->number
show-derivation-outputs
show-what-to-build
show-what-to-build*
show-manifest-transaction
@ -79,8 +81,6 @@ (define-module (guix ui)
package-specification->name+version+output
string->generations
string->duration
args-fold*
parse-command-line
run-guix-command
run-guix
program-name
@ -503,6 +503,14 @@ (define (read/eval-package-expression str)
(leave (_ "expression ~s does not evaluate to a package~%")
str))))
(define (show-derivation-outputs derivation)
"Show the output file names of DERIVATION."
(format #t "~{~a~%~}"
(map (match-lambda
((out-name . out)
(derivation->output-path derivation out-name)))
(derivation-outputs derivation))))
(define* (show-what-to-build store drv
#:key dry-run? (use-substitutes? #t))
"Show what will or would (depending on DRY-RUN?) be built in realizing the
@ -959,52 +967,6 @@ (define* (package-specification->name+version+output spec
;;; Command-line option processing.
;;;
(define (args-fold* options unrecognized-option-proc operand-proc . seeds)
"A wrapper on top of `args-fold' that does proper user-facing error
reporting."
(catch 'misc-error
(lambda ()
(apply args-fold options unrecognized-option-proc
operand-proc seeds))
(lambda (key proc msg args . rest)
;; XXX: MSG is not i18n'd.
(leave (_ "invalid argument: ~a~%")
(apply format #f msg args)))))
(define (environment-build-options)
"Return additional build options passed as environment variables."
(arguments-from-environment-variable "GUIX_BUILD_OPTIONS"))
(define %default-argument-handler
;; The default handler for non-option command-line arguments.
(lambda (arg result)
(alist-cons 'argument arg result)))
(define* (parse-command-line args options seeds
#:key
(argument-handler %default-argument-handler))
"Parse the command-line arguments ARGS as well as arguments passed via the
'GUIX_BUILD_OPTIONS' environment variable according to OPTIONS (a list of
SRFI-37 options) and return the result, seeded by SEEDS.
Command-line options take precedence those passed via 'GUIX_BUILD_OPTIONS'.
ARGUMENT-HANDLER is called for non-option arguments, like the 'operand-proc'
parameter of 'args-fold'."
(define (parse-options-from args seeds)
;; Actual parsing takes place here.
(apply args-fold* args options
(lambda (opt name arg . rest)
(leave (_ "~A: unrecognized option~%") name))
argument-handler
seeds))
(call-with-values
(lambda ()
(parse-options-from (environment-build-options) seeds))
(lambda seeds
;; ARGS take precedence over what the environment variable specifies.
(parse-options-from args seeds))))
(define (show-guix-usage)
(format (current-error-port)
(_ "Try `guix --help' for more information.~%"))

1
po/guix/POTFILES.in
View file

@ -4,6 +4,7 @@ gnu/packages.scm
gnu/system.scm
gnu/services/dmd.scm
gnu/system/shadow.scm
guix/scripts.scm
guix/scripts/build.scm
guix/scripts/download.scm
guix/scripts/package.scm

98
tests/lint.scm
View file

@ -1,7 +1,8 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2014, 2015 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -21,6 +22,7 @@
(define-module (test-lint)
#:use-module (guix tests)
#:use-module (guix download)
#:use-module (guix git-download)
#:use-module (guix build-system gnu)
#:use-module (guix packages)
#:use-module (guix scripts lint)
@ -141,6 +143,13 @@ (define-syntax-rule (with-warnings body ...)
(check-description-style pkg)))
"description should not be empty")))
(test-assert "description: valid Texinfo markup"
(->bool
(string-contains
(with-warnings
(check-description-style (dummy-package "x" (description "f{oo}b@r"))))
"Texinfo markup in description is invalid")))
(test-assert "description: does not start with an upper-case letter"
(->bool
(string-contains (with-warnings
@ -398,6 +407,83 @@ (define-syntax-rule (with-warnings body ...)
(check-home-page pkg))))
"not reachable: 404")))
(test-assert "source-file-name"
(->bool
(string-contains
(with-warnings
(let ((pkg (dummy-package "x"
(version "3.2.1")
(source
(origin
(method url-fetch)
(uri "http://www.example.com/3.2.1.tar.gz")
(sha256 %null-sha256))))))
(check-source-file-name pkg)))
"file name should contain the package name")))
(test-assert "source-file-name: v prefix"
(->bool
(string-contains
(with-warnings
(let ((pkg (dummy-package "x"
(version "3.2.1")
(source
(origin
(method url-fetch)
(uri "http://www.example.com/v3.2.1.tar.gz")
(sha256 %null-sha256))))))
(check-source-file-name pkg)))
"file name should contain the package name")))
(test-assert "source-file-name: bad checkout"
(->bool
(string-contains
(with-warnings
(let ((pkg (dummy-package "x"
(version "3.2.1")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "http://www.example.com/x.git")
(commit "0")))
(sha256 %null-sha256))))))
(check-source-file-name pkg)))
"file name should contain the package name")))
(test-assert "source-file-name: good checkout"
(not
(->bool
(string-contains
(with-warnings
(let ((pkg (dummy-package "x"
(version "3.2.1")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "http://git.example.com/x.git")
(commit "0")))
(file-name (string-append "x-" version))
(sha256 %null-sha256))))))
(check-source-file-name pkg)))
"file name should contain the package name"))))
(test-assert "source-file-name: valid"
(not
(->bool
(string-contains
(with-warnings
(let ((pkg (dummy-package "x"
(version "3.2.1")
(source
(origin
(method url-fetch)
(uri "http://www.example.com/x-3.2.1.tar.gz")
(sha256 %null-sha256))))))
(check-source-file-name pkg)))
"file name should contain the package name"))))
(test-skip (if %http-server-socket 0 1))
(test-equal "source: 200"
""
@ -426,6 +512,16 @@ (define-syntax-rule (with-warnings body ...)
(check-source pkg))))
"not reachable: 404")))
(test-assert "formatting: lonely parentheses"
(string-contains
(with-warnings
(check-formatting
(
dummy-package "ugly as hell!"
)
))
"lonely"))
(test-assert "formatting: tabulation"
(string-contains
(with-warnings

12
tests/packages.scm
View file

@ -177,6 +177,18 @@ (define read-at
(package-transitive-supported-systems d)
(package-transitive-supported-systems e))))
(test-equal "origin-actual-file-name"
"foo-1.tar.gz"
(let ((o (dummy-origin (uri "http://www.example.com/foo-1.tar.gz"))))
(origin-actual-file-name o)))
(test-equal "origin-actual-file-name, file-name"
"foo-1.tar.gz"
(let ((o (dummy-origin
(uri "http://www.example.com/tarball")
(file-name "foo-1.tar.gz"))))
(origin-actual-file-name o)))
(let* ((o (dummy-origin))
(u (dummy-origin))
(i (dummy-origin))

72
tests/scripts.scm Normal file
View file

@ -0,0 +1,72 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (test-scripts)
#:use-module (guix scripts)
#:use-module ((guix scripts build)
#:select (%standard-build-options))
#:use-module (srfi srfi-64))
;; Test the (guix scripts) module.
(define-syntax-rule (with-environment-variable variable value body ...)
"Run BODY with VARIABLE set to VALUE."
(let ((orig (getenv variable)))
(dynamic-wind
(lambda ()
(setenv variable value))
(lambda ()
body ...)
(lambda ()
(if orig
(setenv variable orig)
(unsetenv variable))))))
(test-begin "scripts")
(test-equal "parse-command-line"
'((argument . "bar") (argument . "foo")
(cores . 10) ;takes precedence
(substitutes? . #f) (keep-failed? . #t)
(max-jobs . 77) (cores . 42))
(with-environment-variable "GUIX_BUILD_OPTIONS" "-c 42 -M 77"
(parse-command-line '("--keep-failed" "--no-substitutes"
"--cores=10" "foo" "bar")
%standard-build-options
(list '()))))
(test-equal "parse-command-line and --no options"
'((argument . "foo")
(substitutes? . #f)) ;takes precedence
(with-environment-variable "GUIX_BUILD_OPTIONS" "--no-substitutes"
(parse-command-line '("foo")
%standard-build-options
(list '((substitutes? . #t))))))
(test-end "scripts")
(exit (= (test-runner-fail-count (test-runner-current)) 0))
;;; Local Variables:
;;; eval: (put 'with-environment-variable 'scheme-indent-function 2)
;;; End:

40
tests/ui.scm
View file

@ -22,8 +22,6 @@ (define-module (test-ui)
#:use-module (guix profiles)
#:use-module (guix store)
#:use-module (guix derivations)
#:use-module ((guix scripts build)
#:select (%standard-build-options))
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-19)
@ -54,43 +52,9 @@ (define guile-2.0.9
(item "/gnu/store/...")
(output "out")))
(define-syntax-rule (with-environment-variable variable value body ...)
"Run BODY with VARIABLE set to VALUE."
(let ((orig (getenv variable)))
(dynamic-wind
(lambda ()
(setenv variable value))
(lambda ()
body ...)
(lambda ()
(if orig
(setenv variable orig)
(unsetenv variable))))))
(test-begin "ui")
(test-equal "parse-command-line"
'((argument . "bar") (argument . "foo")
(cores . 10) ;takes precedence
(substitutes? . #f) (keep-failed? . #t)
(max-jobs . 77) (cores . 42))
(with-environment-variable "GUIX_BUILD_OPTIONS" "-c 42 -M 77"
(parse-command-line '("--keep-failed" "--no-substitutes"
"--cores=10" "foo" "bar")
%standard-build-options
(list '()))))
(test-equal "parse-command-line and --no options"
'((argument . "foo")
(substitutes? . #f)) ;takes precedence
(with-environment-variable "GUIX_BUILD_OPTIONS" "--no-substitutes"
(parse-command-line '("foo")
%standard-build-options
(list '((substitutes? . #t))))))
(test-assert "fill-paragraph"
(every (lambda (column)
(every (lambda (width)
@ -282,7 +246,3 @@ (define-syntax-rule (with-environment-variable variable value body ...)
(exit (= (test-runner-fail-count (test-runner-current)) 0))
;;; Local Variables:
;;; eval: (put 'with-environment-variable 'scheme-indent-function 2)
;;; End: