diff options
89 files changed, 3918 insertions, 462 deletions
diff --git a/Makefile.am b/Makefile.am index 9a810e4ebd..a8dab5d326 100644 --- a/Makefile.am +++ b/Makefile.am @@ -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 \ @@ -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> diff --git a/doc/contributing.texi b/doc/contributing.texi index 7b16ea3539..ded54348bc 100644 --- a/doc/contributing.texi +++ b/doc/contributing.texi @@ -207,6 +207,10 @@ 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 (@pxref{Invoking guix lint}). diff --git a/doc/emacs.texi b/doc/emacs.texi index db2e657d27..67773466a4 100644 --- a/doc/emacs.texi +++ b/doc/emacs.texi @@ -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 diff --git a/doc/guix.texi b/doc/guix.texi index 9ae91a8d1e..3ca4cefa63 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -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,23 +7233,70 @@ 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") - ...)) -@end example + (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 diff --git a/doc/package-hello.scm b/doc/package-hello.scm index b3fcd4ff73..c57eb89108 100644 --- a/doc/package-hello.scm +++ b/doc/package-hello.scm @@ -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!") @@ -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 \ diff --git a/emacs/guix-backend.el b/emacs/guix-backend.el index 7db1daacf0..412d648b9d 100644 --- a/emacs/guix-backend.el +++ b/emacs/guix-backend.el @@ -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 &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 (str) + "Evaluate STR with guile expression using Guix REPL. +See `guix-geiser-eval' for details." + (guix-geiser-eval str (guix-get-repl-buffer 'internal))) + +(defun guix-eval-read (str) + "Evaluate STR with guile expression using Guix REPL. +See `guix-geiser-eval-read' for details." + (guix-geiser-eval-read str (guix-get-repl-buffer 'internal))) (defun guix-eval-in-repl (str &optional operation-buffer operation-type) "Switch to Guix REPL and evaluate STR with guile expression there. @@ -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) diff --git a/emacs/guix-base.el b/emacs/guix-base.el index 3bee910b05..e64e375e33 100644 --- a/emacs/guix-base.el +++ b/emacs/guix-base.el @@ -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." diff --git a/emacs/guix-build-log.el b/emacs/guix-build-log.el new file mode 100644 index 0000000000..6faa37c311 --- /dev/null +++ b/emacs/guix-build-log.el @@ -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 diff --git a/emacs/guix-command.el b/emacs/guix-command.el index 81f619f434..504d5f7ca0 100644 --- a/emacs/guix-command.el +++ b/emacs/guix-command.el @@ -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)) diff --git a/emacs/guix-geiser.el b/emacs/guix-geiser.el new file mode 100644 index 0000000000..eb449bcdb1 --- /dev/null +++ b/emacs/guix-geiser.el @@ -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 diff --git a/emacs/guix-guile.el b/emacs/guix-guile.el new file mode 100644 index 0000000000..cff9bd4e9b --- /dev/null +++ b/emacs/guix-guile.el @@ -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 diff --git a/emacs/guix-info.el b/emacs/guix-info.el index 4bdd62a6a5..260c7680f5 100644 --- a/emacs/guix-info.el +++ b/emacs/guix-info.el @@ -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. diff --git a/emacs/guix-list.el b/emacs/guix-list.el index 9796464dbf..87d214bb4d 100644 --- a/emacs/guix-list.el +++ b/emacs/guix-list.el @@ -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'. diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm index c9b84d36d9..e29a0a0acc 100644 --- a/emacs/guix-main.scm +++ b/emacs/guix-main.scm @@ -71,6 +71,18 @@ (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 @@ GENERATIONS is a list of generation numbers." (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." diff --git a/emacs/guix-prettify.el b/emacs/guix-prettify.el index 24dfbb33e2..38d72e860b 100644 --- a/emacs/guix-prettify.el +++ b/emacs/guix-prettify.el @@ -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")))) diff --git a/emacs/guix-utils.el b/emacs/guix-utils.el index c1ce954f8f..d1f088b6a8 100644 --- a/emacs/guix-utils.el +++ b/emacs/guix-utils.el @@ -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 diff --git a/emacs/guix.el b/emacs/guix.el index 244696a184..ac6efbb475 100644 --- a/emacs/guix.el +++ b/emacs/guix.el @@ -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." diff --git a/gnu-system.am b/gnu-system.am index bc108c85ad..f359a9b834 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -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 \ diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm index 3081a93a97..30d6570b04 100644 --- a/gnu/build/linux-boot.scm +++ b/gnu/build/linux-boot.scm @@ -48,7 +48,7 @@ ;;; 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 @@ (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 @@ (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 @@ with the given MAJOR number, starting with MINOR." (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 @@ UNIONFS." (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 @@ to it are lost." (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 @@ to it are lost." #: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)) diff --git a/gnu/packages/abiword.scm b/gnu/packages/abiword.scm index a76b16c5af..c6f259a2dd 100644 --- a/gnu/packages/abiword.scm +++ b/gnu/packages/abiword.scm @@ -99,8 +99,15 @@ ("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+))) diff --git a/gnu/packages/audio.scm b/gnu/packages/audio.scm index 65859f6bed..cbf06250d0 100644 --- a/gnu/packages/audio.scm +++ b/gnu/packages/audio.scm @@ -1052,7 +1052,25 @@ lv2-c++-tools.") "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))) diff --git a/gnu/packages/autogen.scm b/gnu/packages/autogen.scm index 45b7cb81cc..615839f463 100644 --- a/gnu/packages/autogen.scm +++ b/gnu/packages/autogen.scm @@ -30,16 +30,16 @@ (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))) diff --git a/gnu/packages/base.scm b/gnu/packages/base.scm index f60a6cfeef..69db178e05 100644 --- a/gnu/packages/base.scm +++ b/gnu/packages/base.scm @@ -52,22 +52,23 @@ (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 diff --git a/gnu/packages/bioinformatics.scm b/gnu/packages/bioinformatics.scm index bbd02f3123..1977fd3bf9 100644 --- a/gnu/packages/bioinformatics.scm +++ b/gnu/packages/bioinformatics.scm @@ -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 @@ #: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 @@ #: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 @@ resolution of binding sites through combining the information of both 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 @@ data in the form of VCF files.") ;; 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))) diff --git a/gnu/packages/compression.scm b/gnu/packages/compression.scm index df62e9963e..f4b327ecec 100644 --- a/gnu/packages/compression.scm +++ b/gnu/packages/compression.scm @@ -357,17 +357,15 @@ This package is mostly for compatibility and historical interest.") (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 diff --git a/gnu/packages/databases.scm b/gnu/packages/databases.scm index e1cac39cc5..a17424196a 100644 --- a/gnu/packages/databases.scm +++ b/gnu/packages/databases.scm @@ -289,7 +289,8 @@ pictures, sounds, or video.") (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' diff --git a/gnu/packages/emacs.scm b/gnu/packages/emacs.scm index b6ca6cfc66..dcbe5e5bd5 100644 --- a/gnu/packages/emacs.scm +++ b/gnu/packages/emacs.scm @@ -1092,3 +1092,77 @@ prefer the listing of bugs as TODO items of @code{org-mode}, you could use 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+))) diff --git a/gnu/packages/game-development.scm b/gnu/packages/game-development.scm index 9c918dee35..c1757ac4de 100644 --- a/gnu/packages/game-development.scm +++ b/gnu/packages/game-development.scm @@ -102,19 +102,21 @@ clone.") (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) diff --git a/gnu/packages/gnome.scm b/gnu/packages/gnome.scm index b55058b169..b4b5c237c9 100644 --- a/gnu/packages/gnome.scm +++ b/gnu/packages/gnome.scm @@ -44,6 +44,7 @@ #: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 @@ #: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 @@ #: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 @@ manage, and publish documentation for Yelp and the web. Most of the heavy 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+))) diff --git a/gnu/packages/gnu-pw-mgr.scm b/gnu/packages/gnu-pw-mgr.scm index 7a9b0b9810..e7b93f024e 100644 --- a/gnu/packages/gnu-pw-mgr.scm +++ b/gnu/packages/gnu-pw-mgr.scm @@ -29,7 +29,7 @@ (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 @@ version ".tar.xz")) (sha256 (base32 - "0a352y1m33vp6zmdbn96fdrq9gr9lchc9vcrj14mfx7g0dsvxjns")))) + "1winmckl4h8lypg57hd3nd7jscpdr7f1v8zi432k5h648izkf2dg")))) (build-system gnu-build-system) (native-inputs `(("which" ,which) diff --git a/gnu/packages/guile.scm b/gnu/packages/guile.scm index f06f66c7a5..d5a95a0444 100644 --- a/gnu/packages/guile.scm +++ b/gnu/packages/guile.scm @@ -185,18 +185,19 @@ without requiring the source code to be rewritten.") ;; 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 @@ without requiring the source code to be rewritten.") (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 @@ without requiring the source code to be rewritten.") ("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. diff --git a/gnu/packages/libusb.scm b/gnu/packages/libusb.scm index e7f5b8b119..266669061e 100644 --- a/gnu/packages/libusb.scm +++ b/gnu/packages/libusb.scm @@ -96,7 +96,8 @@ version of libusb to run with newer libusb.") "/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))) diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index e7127ffa58..d2619335a3 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -210,7 +210,7 @@ for SYSTEM, or #f if there is no configuration for SYSTEM." #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 @@ for SYSTEM, or #f if there is no configuration for SYSTEM." (uri (linux-libre-urls version)) (sha256 (base32 - "0jfgbr9qc92bk7hyfdvw030xyic2bg834l8cxp25rw9qbbdck3rs")))) + "140cqnk1hyhavfra572wwzwz7pddczc78j8anbxyciw35kh8z2hl")))) (build-system gnu-build-system) (native-inputs `(("perl" ,perl) ("bc" ,bc) diff --git a/gnu/packages/music.scm b/gnu/packages/music.scm index 05a490574b..78310edf0e 100644 --- a/gnu/packages/music.scm +++ b/gnu/packages/music.scm @@ -187,7 +187,7 @@ you to define complex tempo maps for entire songs or performances.") (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 @@ you to define complex tempo maps for entire songs or performances.") 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 @@ you to define complex tempo maps for entire songs or performances.") (inputs `(("guile" ,guile-1.8) ("font-dejavu" ,font-dejavu) + ("font-tex-gyre" ,font-tex-gyre) ("fontconfig" ,fontconfig) ("freetype" ,freetype) ("ghostscript" ,ghostscript) diff --git a/gnu/packages/networking.scm b/gnu/packages/networking.scm index dc139e28fe..0a7cde0b0d 100644 --- a/gnu/packages/networking.scm +++ b/gnu/packages/networking.scm @@ -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 @@ #: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 @@ receiving NDP messages.") 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+))) diff --git a/gnu/packages/openstack.scm b/gnu/packages/openstack.scm index 91686441ba..39584d566f 100644 --- a/gnu/packages/openstack.scm +++ b/gnu/packages/openstack.scm @@ -25,6 +25,41 @@ #: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 @@ and sensible default behaviors into your setuptools run.") (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 @@ in an application or library.") (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 @@ and better support for mocking results.") (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)) diff --git a/gnu/packages/password-utils.scm b/gnu/packages/password-utils.scm index 4aef371615..8619f14f38 100644 --- a/gnu/packages/password-utils.scm +++ b/gnu/packages/password-utils.scm @@ -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 @@ (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))) diff --git a/gnu/packages/patches/libmtp-devices.patch b/gnu/packages/patches/libmtp-devices.patch new file mode 100644 index 0000000000..9b985e526d --- /dev/null +++ b/gnu/packages/patches/libmtp-devices.patch @@ -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. + */ diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index f57bd839ab..ca367929e0 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -783,6 +783,9 @@ password storage.") ;; "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 @@ computing.") `(#: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 @@ PEP 8.") "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 @@ complexity of Python source code.") "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 @@ reading and writing MessagePack data.") (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)) diff --git a/gnu/packages/ruby.scm b/gnu/packages/ruby.scm index ee0acc8639..c906361971 100644 --- a/gnu/packages/ruby.scm +++ b/gnu/packages/ruby.scm @@ -421,6 +421,30 @@ Java Native Interface.") (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 @@ extensions.") (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 @@ interfaces.") (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 @@ it unifies the API for web servers, web frameworks, and software in between 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))) diff --git a/gnu/packages/scheme.scm b/gnu/packages/scheme.scm index 803b8d5a20..7465b1b58c 100644 --- a/gnu/packages/scheme.scm +++ b/gnu/packages/scheme.scm @@ -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 @@ addition to support for lightweight VM-based threads, each VM itself runs in 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+)))) diff --git a/gnu/packages/statistics.scm b/gnu/packages/statistics.scm index 2e89fa9f03..cbcef49153 100644 --- a/gnu/packages/statistics.scm +++ b/gnu/packages/statistics.scm @@ -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 @@ available, greatly increasing its breadth and scope.") (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 @@ colors are provided.") (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 @@ effects of different types of color-blindness.") (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 @@ OpenSSL should be used.") (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 @@ OpenSSL should be used.") (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 @@ algorithms.") (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 @@ see package vignette. To quote Rene Magritte, \"Ceci n'est pas un pipe.\"") (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 @@ Munsell colour system.") (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 @@ and Francois (2011, JSS), and the book by Eddelbuettel (2013, Springer); see (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 @@ panels or collapse high-dimensional arrays to simpler summary statistics.") (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 @@ prototype-based, rather than class-based object oriented ideas.") (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 @@ designed by Cynthia Brewer as described at http://colorbrewer2.org") (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 @@ transliteration, concatenation, date-time formatting and parsing, etc.") (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 @@ the input of another.") (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 @@ using just two functions: melt and dcast (or acast).") (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 @@ legends.") (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 @@ by step from multiple data sources. It also implements a sophisticated 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))) diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm index 7f4f7f8f0e..b4c518acf7 100644 --- a/gnu/packages/version-control.scm +++ b/gnu/packages/version-control.scm @@ -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 @@ #: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 @@ sources files, and documents. It fills a similar role to the free software 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") diff --git a/gnu/packages/vpn.scm b/gnu/packages/vpn.scm index 4cd5cd9b11..6af87d2657 100644 --- a/gnu/packages/vpn.scm +++ b/gnu/packages/vpn.scm @@ -63,7 +63,7 @@ endpoints.") (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")) diff --git a/gnu/system.scm b/gnu/system.scm index ea6e9c13ea..cee5f37bcb 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -83,6 +83,11 @@ 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 @@ variable is not set---hence the need for this 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 @@ etc." ;; 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 @@ etc." ;; 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 diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm index b177f93398..8155b273e3 100644 --- a/gnu/system/file-systems.scm +++ b/gnu/system/file-systems.scm @@ -47,7 +47,6 @@ %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 @@ UUID representation." (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 @@ UUID representation." (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 diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm new file mode 100644 index 0000000000..fdf7460872 --- /dev/null +++ b/gnu/system/linux-container.scm @@ -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)))))) diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index 48b855b567..519373fe34 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -182,6 +182,7 @@ loaded at boot time in the order in which they appear." "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 '()) diff --git a/guix/build-system/r.scm b/guix/build-system/r.scm index 4daec5eb66..da06cb1358 100644 --- a/guix/build-system/r.scm +++ b/guix/build-system/r.scm @@ -28,7 +28,8 @@ #: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 @@ ;; ;; 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) diff --git a/guix/build/download.scm b/guix/build/download.scm index 6e85174bc9..d362fc1f26 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -36,8 +36,10 @@ 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 @@ ;; 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 @@ object, as an inexact number." (/ (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 @@ way." (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 @@ width of the bar is BAR-WIDTH." (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 @@ bytes long. The returned procedure is suitable for use as an argument to (/ 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)))))))) diff --git a/guix/build/ruby-build-system.scm b/guix/build/ruby-build-system.scm index 4184ccc9ac..2685da1a72 100644 --- a/guix/build/ruby-build-system.scm +++ b/guix/build/ruby-build-system.scm @@ -41,53 +41,63 @@ directory." ((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 (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)))) - - ;; 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)))) + (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)) + + ;; 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" (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? diff --git a/guix/download.scm b/guix/download.scm index 42956772f5..204cfc0826 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -167,9 +167,9 @@ (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/" diff --git a/guix/import/cran.scm b/guix/import/cran.scm index 8ed5e5407f..585cb9fec2 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -165,7 +165,7 @@ representation of the package page." (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)))))) diff --git a/guix/licenses.scm b/guix/licenses.scm index c3b76af9b9..7e05b32993 100644 --- a/guix/licenses.scm +++ b/guix/licenses.scm @@ -61,6 +61,7 @@ sleepycat vim x11 x11-style + zpl2.1 zlib fsf-free)) @@ -382,6 +383,11 @@ which may be a file:// URI pointing the package's tree." "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" diff --git a/guix/packages.scm b/guix/packages.scm index 49c6b44884..72822b8c97 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -37,6 +37,7 @@ #: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 @@ origin-method origin-sha256 origin-file-name + origin-actual-file-name origin-patches origin-patch-flags origin-patch-inputs @@ -189,6 +191,26 @@ representation." ((_ 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. diff --git a/guix/scripts.scm b/guix/scripts.scm new file mode 100644 index 0000000000..e34d38904c --- /dev/null +++ b/guix/scripts.scm @@ -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 diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm index ab2fc46c31..b120c555e3 100644 --- a/guix/scripts/archive.scm +++ b/guix/scripts/archive.scm @@ -27,6 +27,7 @@ #: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) diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index ab2a39b1f8..a357cf8aa4 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -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 @@ arguments with packages that use the specified source." 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 diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm index 87b420405c..533970ffbb 100644 --- a/guix/scripts/download.scm +++ b/guix/scripts/download.scm @@ -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) diff --git a/guix/scripts/edit.scm b/guix/scripts/edit.scm index fc453ac38d..30146af10b 100644 --- a/guix/scripts/edit.scm +++ b/guix/scripts/edit.scm @@ -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) diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index ecdbc7aa37..7aa52e8a8a 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -27,6 +27,7 @@ #: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) diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm index 6403893687..7e06c72ccb 100644 --- a/guix/scripts/gc.scm +++ b/guix/scripts/gc.scm @@ -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) diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm index 2b671be131..725ae42030 100644 --- a/guix/scripts/graph.scm +++ b/guix/scripts/graph.scm @@ -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 @@ #: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 @@ ;;; 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))) diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm index e2305d73ee..d44095377b 100644 --- a/guix/scripts/hash.scm +++ b/guix/scripts/hash.scm @@ -22,6 +22,7 @@ #: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) diff --git a/guix/scripts/import/cpan.scm b/guix/scripts/import/cpan.scm index 1f4dedf23f..3d470f684d 100644 --- a/guix/scripts/import/cpan.scm +++ b/guix/scripts/import/cpan.scm @@ -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) diff --git a/guix/scripts/import/cran.scm b/guix/scripts/import/cran.scm index f11fa1004f..8d001ac494 100644 --- a/guix/scripts/import/cran.scm +++ b/guix/scripts/import/cran.scm @@ -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) diff --git a/guix/scripts/import/elpa.scm b/guix/scripts/import/elpa.scm index c72aaf0760..b22a7c4c23 100644 --- a/guix/scripts/import/elpa.scm +++ b/guix/scripts/import/elpa.scm @@ -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) diff --git a/guix/scripts/import/gem.scm b/guix/scripts/import/gem.scm index 9f8094feac..a5dd2a7822 100644 --- a/guix/scripts/import/gem.scm +++ b/guix/scripts/import/gem.scm @@ -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) diff --git a/guix/scripts/import/gnu.scm b/guix/scripts/import/gnu.scm index 5fac6db516..92bd8305ea 100644 --- a/guix/scripts/import/gnu.scm +++ b/guix/scripts/import/gnu.scm @@ -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) diff --git a/guix/scripts/import/hackage.scm b/guix/scripts/import/hackage.scm index 1e33556481..8d31128c47 100644 --- a/guix/scripts/import/hackage.scm +++ b/guix/scripts/import/hackage.scm @@ -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 @@ package will be generated. If no version suffix is pecified, then the 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")) diff --git a/guix/scripts/import/nix.scm b/guix/scripts/import/nix.scm index 2dc2677c54..dba053b313 100644 --- a/guix/scripts/import/nix.scm +++ b/guix/scripts/import/nix.scm @@ -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) diff --git a/guix/scripts/import/pypi.scm b/guix/scripts/import/pypi.scm index 1e03843840..7166b014eb 100644 --- a/guix/scripts/import/pypi.scm +++ b/guix/scripts/import/pypi.scm @@ -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) diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index 2a618c9451..8224f540bb 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -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 @@ #: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 @@ check-derivation check-home-page check-source + check-source-file-name check-license check-formatting @@ -140,6 +143,13 @@ monad." (_ "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 @@ by two spaces; possible infraction~p at ~{~a~^, ~}") (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 @@ descriptions maintained upstream." (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 @@ descriptions maintained upstream." (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)) @@ -643,6 +687,10 @@ or a list thereof") (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") (check check-derivation)) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 23f1597856..e0fe1ddb27 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -29,6 +29,7 @@ #: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)) diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm index cc96355947..e352090d2d 100644 --- a/guix/scripts/publish.scm +++ b/guix/scripts/publish.scm @@ -45,6 +45,7 @@ #:use-module (guix store) #:use-module (guix serialization) #:use-module (guix ui) + #:use-module (guix scripts) #:export (guix-publish)) (define (show-help) diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index e8459e5ffb..56ee9acb18 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -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) diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index e7980a97b0..097059e372 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -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) diff --git a/guix/scripts/size.scm b/guix/scripts/size.scm index ee070f14b1..44ff92655b 100644 --- a/guix/scripts/size.scm +++ b/guix/scripts/size.scm @@ -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) diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index e908bc997e..ec8e6244af 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -31,7 +31,8 @@ #: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 @@ or is signed by an unauthorized key." (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 @@ DESTINATION as a nar file. Verify the substitute against ACL." ;; 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 @@ DESTINATION as a nar file. Verify the substitute against ACL." (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) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 45f598219d..5e2d226dfe 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -26,6 +26,7 @@ #: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 @@ it atomically, and then run OS's activation script." ((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 @@ Build the operating system declared in FILE according to ACTION.\n")) (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) diff --git a/guix/store.scm b/guix/store.scm index 132b8a3ac4..5f37e72589 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -58,6 +58,7 @@ close-connection with-store set-build-options + set-build-options* valid-path? query-path-hash hash-part->path @@ -986,6 +987,9 @@ permission bits are kept." ;; 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. diff --git a/guix/ui.scm b/guix/ui.scm index ca5b844a43..4a3630f242 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -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 @@ #: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 @@ 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 @@ 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 @@ error." (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 @@ optionally contain a version number and an output name, as in these examples: ;;; 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.~%")) diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in index 5c2639129b..c0f169eca4 100644 --- a/po/guix/POTFILES.in +++ b/po/guix/POTFILES.in @@ -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 diff --git a/tests/lint.scm b/tests/lint.scm index ac47dbb768..3f149562d4 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -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 @@ requests." (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 @@ requests." (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 @@ requests." (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 diff --git a/tests/packages.scm b/tests/packages.scm index 00a0998b4c..ace2f36f19 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -177,6 +177,18 @@ (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)) diff --git a/tests/scripts.scm b/tests/scripts.scm new file mode 100644 index 0000000000..3bf41aed4d --- /dev/null +++ b/tests/scripts.scm @@ -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: diff --git a/tests/ui.scm b/tests/ui.scm index 1478fe213e..25fc709431 100644 --- a/tests/ui.scm +++ b/tests/ui.scm @@ -22,8 +22,6 @@ #: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 @@ interface, and powerful string processing.") (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 @@ Second line" 24)) (exit (= (test-runner-fail-count (test-runner-current)) 0)) - -;;; Local Variables: -;;; eval: (put 'with-environment-variable 'scheme-indent-function 2) -;;; End: |