me
/
guix
Archived
1
0
Fork 0
Code

Merge branch 'master' into staging

master
Marius Bakke 2018-03-19 03:50:39 +01:00
parent 7ace97395f be95bcf088
commit 4eade64706
No known key found for this signature in database
GPG Key ID: A2A06DF2A33A54FA
13 changed files with 503 additions and 106 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
gnu/build/linux-modules.scm
View File

@ -206,7 +206,9 @@ appears in BLACK-LIST are not loaded."
(define (load-dependencies file)
(let ((dependencies (module-dependencies file)))
(every (cut load-linux-module* <> #:lookup-module lookup-module)
(every (cut load-linux-module* <>
#:lookup-module lookup-module
#:black-list black-list)
(map lookup-module dependencies))))
(and (not (black-listed? (file-name->module-name file)))
@ -327,7 +329,7 @@ The modules corresponding to these aliases can then be found using
list of alias/module pairs where each alias is a glob pattern as like the
result of:
(compile-glob-pattern \"scsi:t-0x01*\")
(string->compiled-sglob \"scsi:t-0x01*\")
and each module is a module name like \"snd_hda_intel\"."
(define (comment? str)
@ -352,17 +354,20 @@ and each module is a module name like \"snd_hda_intel\"."
(line
(match (tokenize line)
(("alias" alias module)
(loop (alist-cons (compile-glob-pattern alias) module
(loop (alist-cons (string->compiled-sglob alias) module
aliases)))
(() ;empty line
(loop aliases)))))))
(define (current-alias-file)
"Return the absolute file name of the default 'modules.alias' file."
(define (current-kernel-directory)
"Return the directory of the currently running Linux kernel."
(string-append (or (getenv "LINUX_MODULE_DIRECTORY")
"/run/booted-system/kernel/lib/modules")
"/" (utsname:release (uname))
"/" "modules.alias"))
"/" (utsname:release (uname))))
(define (current-alias-file)
"Return the absolute file name of the default 'modules.alias' file."
(string-append (current-kernel-directory) "/modules.alias"))
(define* (known-module-aliases #:optional (alias-file (current-alias-file)))
"Return the list of alias/module pairs read from ALIAS-FILE. Each alias is

31
gnu/packages/cran.scm
View File

@ -3,6 +3,7 @@
;;; Copyright © 2017 Roel Janssen <roel@gnu.org>
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2017 Raoul Bonnal <ilpuccio.febo@gmail.com>
;;; Copyright © 2018 Vijayalakshmi Vedantham <vijimay12@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -59,6 +60,36 @@ diversification and macroevolution, computing distances from DNA sequences,
and several other tools.")
(license license:gpl2+)))
(define-public r-abbyyr
(package
(name "r-abbyyr")
(version "0.5.1")
(source
(origin
(method url-fetch)
(uri (cran-uri "abbyyR" version))
(sha256
(base32
"1s8zf18sh0s89vk3dl09fzrq50csmmfvmsanf5vfkv9n5lx6pklg"))))
(properties `((upstream-name . "abbyyR")))
(build-system r-build-system)
(propagated-inputs
`(("r-curl" ,r-curl)
("r-httr" ,r-httr)
("r-plyr" ,r-plyr)
("r-progress" ,r-progress)
("r-readr" ,r-readr)
("r-xml" ,r-xml)))
(home-page "https://github.com/soodoku/abbyyR")
(synopsis "Access to Abbyy Optical Character Recognition (OCR) API")
(description
"This package provides tools to get text from images of text using Abbyy
Cloud Optical Character Recognition (OCR) API. With abbyyyR, one can easily
OCR images, barcodes, forms, documents with machine readable zones, e.g.
passports and get the results in a variety of formats including plain text and
XML. To learn more about the Abbyy OCR API, see @url{http://ocrsdk.com/}.")
(license license:expat)))
(define-public r-colorspace
(package
(name "r-colorspace")

4
gnu/packages/gnome.scm
View File

@ -4424,7 +4424,7 @@ metadata in photo and video files of various formats.")
(define-public shotwell
(package
(name "shotwell")
(version "0.27.4")
(version "0.28.0")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnome/sources/" name "/"
@ -4432,7 +4432,7 @@ metadata in photo and video files of various formats.")
name "-" version ".tar.xz"))
(sha256
(base32
"0g2vphhpxrljpy9sryfsgaayix807i1i9plj9bay72dk0zphqab2"))))
"1d797nmlz9gs6ri0h65b76s40ss6ma6h6405xqx03lhg5xni3kmg"))))
(build-system glib-or-gtk-build-system)
(propagated-inputs
`(("dconf" ,dconf)))

5
gnu/packages/gnuzilla.scm
View File

@ -449,7 +449,10 @@ security standards.")
(mozilla-patch "icecat-bug-1442127-pt2.patch" "da5792b70f30" "116k9qja5ir9b3laazasp43f5jx59qq72nknmq5bn5v1ixya9r4l")
(mozilla-patch "icecat-CVE-2018-5125-pt8.patch" "62b831df8269" "109pn0hqn7s27580glv4z7qv1pmjzii9szvf3wkn97k5wybrzgkx")
(mozilla-patch "icecat-bug-1442504.patch" "8954ce68a364" "0bl65zw82bwqg0mmcri94pxqq6ibff7y5rclkzapb081p6yvf73q")
(mozilla-patch "icecat-CVE-2018-5125-pt9.patch" "8a16f439117c" "108iarql6z7h1r4rlzac6n6lrzs78x7kcdbfa0b5dbr5xc66jmgb")))
(mozilla-patch "icecat-CVE-2018-5125-pt9.patch" "8a16f439117c" "108iarql6z7h1r4rlzac6n6lrzs78x7kcdbfa0b5dbr5xc66jmgb")
(mozilla-patch "icecat-bug-1426603.patch" "ca0b92ecedee" "0dc3mdl4a3hrq4j384zjavf3splj6blv4masign710hk7svlgbhq")
(mozilla-patch "icecat-CVE-2018-5146.patch" "494e5d5278ba" "1yb4lxjw499ppwhk31vz0vzl0cfqvj9d4jwqag7ayj53ybwsqgjr")
(mozilla-patch "icecat-CVE-2018-5147.patch" "5cd5586a2f48" "10s774pwvj6xfk3kk6ivnhp2acc8x9sqq6na8z47nkhgwl2712i5")))
(modules '((guix build utils)))
(snippet
'(begin

34
gnu/packages/maths.scm
View File

@ -53,6 +53,7 @@
#:use-module (guix build-system gnu)
#:use-module (guix build-system ocaml)
#:use-module (guix build-system r)
#:use-module (guix build-system ruby)
#:use-module (gnu packages algebra)
#:use-module (gnu packages autotools)
#:use-module (gnu packages bison)
@ -97,6 +98,7 @@
#:use-module (gnu packages python-web)
#:use-module (gnu packages qt)
#:use-module (gnu packages readline)
#:use-module (gnu packages ruby)
#:use-module (gnu packages tbb)
#:use-module (gnu packages scheme)
#:use-module (gnu packages shells)
@ -1940,6 +1942,38 @@ special functions. It uses Matlab function names where appropriate to simplify
porting.")
(license license:gpl3+)))
(define-public ruby-asciimath
(package
(name "ruby-asciimath")
(version "1.0.4")
(source
(origin
(method url-fetch)
(uri (rubygems-uri "asciimath" version))
(sha256
(base32
"1d80kiph5mc78zps7si1hv48kv4k12mzaq8jk5kb3pqpjdr72qmc"))))
(build-system ruby-build-system)
(arguments
'(#:phases
(modify-phases %standard-phases
;; Apply this patch
;; https://github.com/asciidoctor/asciimath/commit/1c06fdc8086077f4785479f78b0823a4a72d7948
(add-after 'unpack 'patch-remove-spurious-backslashes
(lambda _
(substitute* "spec/parser_spec.rb"
(("\\\\\"")
"\"")))))))
(native-inputs
`(("bundler" ,bundler)
("ruby-rspec" ,ruby-rspec)))
(synopsis "AsciiMath parsing and conversion library")
(description
"A pure Ruby AsciiMath parsing and conversion library. AsciiMath is an
easy-to-write markup language for mathematics.")
(home-page "https://github.com/asciidoctor/asciimath")
(license license:expat)))
(define-public superlu
(package
(name "superlu")

260
gnu/packages/ruby.scm
View File

@ -36,6 +36,7 @@
#:use-module (gnu packages autotools)
#:use-module (gnu packages java)
#:use-module (gnu packages libffi)
#:use-module (gnu packages maths)
#:use-module (gnu packages networking)
#:use-module (gnu packages python)
#:use-module (gnu packages ragel)
@ -665,6 +666,72 @@ line of code.")
;; of the Expat license.
(license license:bsd-3)))
(define-public ruby-asciidoctor
(package
(name "ruby-asciidoctor")
(version "1.5.6.1")
(source
(origin
(method url-fetch)
(uri (rubygems-uri "asciidoctor" version))
(sha256
(base32
"1jnf9y8q5asfdzilp8vcqafrc2faj719df4yh1993mh6jd0iqdy4"))))
(build-system ruby-build-system)
(arguments
`(#:test-target "test:all"
#:phases
(modify-phases %standard-phases
(add-before 'check 'remove-circular-tests
(lambda _
;; Remove tests that require circular dependencies to load or pass.
(delete-file "test/invoker_test.rb")
(delete-file "test/converter_test.rb")
(delete-file "test/options_test.rb")
#t)))))
(native-inputs
`(("ruby-minitest" ,ruby-minitest)
("ruby-nokogiri" ,ruby-nokogiri)
("ruby-asciimath" ,ruby-asciimath)
("ruby-coderay" ,ruby-coderay)))
(synopsis "Converter from AsciiDoc content to other formats")
(description
"Asciidoctor is a text processor and publishing toolchain for converting
AsciiDoc content to HTML5, DocBook 5 (or 4.5) and other formats.")
(home-page "http://asciidoctor.org")
(license license:expat)))
(define-public ruby-sporkmonger-rack-mount
;; Testing the addressable gem requires a newer commit than that released, so
;; use an up to date version.
(let ((revision "1")
(commit "076aa2c47d9a4c081f1e9bcb56a826a9e72bd5c3"))
(package
(name "ruby-sporkmonger-rack-mount")
(version (git-version "0.8.3" revision commit))
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/sporkmonger/rack-mount.git")
(commit commit)))
(file-name (git-file-name name version))
(sha256
(base32
"1scx273g3xd93424x9lxc4zyvcp2niknbw5mkz6wkivpf7xsyxdq"))))
(build-system ruby-build-system)
(arguments
;; Tests currently fail so disable them.
;; https://github.com/sporkmonger/rack-mount/pull/1
`(#:tests? #f))
(propagated-inputs `(("ruby-rack" ,ruby-rack)))
(synopsis "Stackable dynamic tree based Rack router")
(description
"@code{Rack::Mount} supports Rack's @code{X-Cascade} convention to
continue trying routes if the response returns pass. This allows multiple
routes to be nested or stacked on top of each other.")
(home-page "https://github.com/sporkmonger/rack-mount")
(license license:expat))))
(define-public ruby-ci-reporter
(package
(name "ruby-ci-reporter")
@ -824,6 +891,29 @@ functions.")
(home-page "https://github.com/ahoward/options")
(license license:ruby)))
(define-public ruby-erubis
(package
(name "ruby-erubis")
(version "2.7.0")
(source
(origin
(method url-fetch)
(uri (rubygems-uri "erubis" version))
(sha256
(base32
"1fj827xqjs91yqsydf0zmfyw9p4l2jz5yikg3mppz6d7fi8kyrb3"))))
(build-system ruby-build-system)
(arguments
'(#:tests? #f)) ; tests do not run properly with Ruby 2.0
(synopsis "Implementation of embedded Ruby (eRuby)")
(description
"Erubis is a fast implementation of embedded Ruby (eRuby) with several
features such as multi-language support, auto escaping, auto trimming spaces
around @code{<% %>}, a changeable embedded pattern, and Ruby on Rails
support.")
(home-page "http://www.kuwata-lab.com/erubis/")
(license license:expat)))
(define-public ruby-orderedhash
(package
(name "ruby-orderedhash")
@ -3293,6 +3383,106 @@ into a single method call.")
(home-page "https://rack.github.io/")
(license license:expat)))
(define-public ruby-rack-test
(package
(name "ruby-rack-test")
(version "0.8.3")
(source
(origin
(method url-fetch)
(uri (rubygems-uri "rack-test" version))
(sha256
(base32
"14ij39zywvr1i9f6jsixfg4zxi2q1m1n1nydvf47f0b6sfc9mv1g"))))
(build-system ruby-build-system)
(arguments
;; Disable tests because of circular dependencies: requires sinatra,
;; which requires rack-protection, which requires rack-test. Instead
;; simply require the library.
`(#:phases
(modify-phases %standard-phases
(replace 'check
(lambda _
(invoke "ruby" "-Ilib" "-r" "rack/test"))))))
(propagated-inputs
`(("ruby-rack" ,ruby-rack)))
(synopsis "Testing API for Rack applications")
(description
"Rack::Test is a small, simple testing API for Rack applications. It can
be used on its own or as a reusable starting point for Web frameworks and
testing libraries to build on.")
(home-page "https://github.com/rack-test/rack-test")
(license license:expat)))
(define-public ruby-rack-protection
(package
(name "ruby-rack-protection")
(version "2.0.1")
(source
(origin
(method url-fetch)
(uri (rubygems-uri "rack-protection" version))
(sha256
(base32
"0ywmgh7x8ljf7jfnq5hmfzki3f803waji3fcvi107w7mlyflbng7"))))
(build-system ruby-build-system)
(arguments
'(;; Tests missing from the gem
#:tests? #f))
(propagated-inputs
`(("ruby-rack" ,ruby-rack)))
(native-inputs
`(("bundler" ,bundler)
("ruby-rspec" ,ruby-rspec-2)
("ruby-rack-test" ,ruby-rack-test)))
(synopsis "Rack middleware that protects against typical web attacks")
(description "Rack middleware that can be used to protect against typical
web attacks. It can protect all Rack apps, including Rails. For instance, it
protects against cross site request forgery, cross site scripting,
clickjacking, directory traversal, session hijacking and IP spoofing.")
(home-page "https://github.com/sinatra/sinatra/tree/master/rack-protection")
(license license:expat)))
(define-public ruby-contest
(package
(name "ruby-contest")
(version "0.1.3")
(source
(origin
(method url-fetch)
(uri (rubygems-uri "contest" version))
(sha256
(base32
"1p9f2292b7b0fbrcjswvj9v01z7ig5ig52328wyqcabgb553qsdf"))))
(build-system ruby-build-system)
(synopsis "Write declarative tests using nested contexts")
(description
"Contest allows writing declarative @code{Test::Unit} tests using nested
contexts without performance penalties.")
(home-page "https://github.com/citrusbyte/contest")
(license license:expat)))
(define-public ruby-creole
(package
(name "ruby-creole")
(version "0.5.0")
(source
(origin
(method url-fetch)
(uri (rubygems-uri "creole" version))
(sha256
(base32
"00rcscz16idp6dx0dk5yi5i0fz593i3r6anbn5bg2q07v3i025wm"))))
(build-system ruby-build-system)
(native-inputs
`(("ruby-bacon" ,ruby-bacon)))
(synopsis "Creole markup language converter")
(description
"Creole is a lightweight markup language and this library for converting
creole to @code{HTML}.")
(home-page "https://github.com/minad/creole")
(license license:ruby)))
(define-public ruby-docile
(package
(name "ruby-docile")
@ -3526,6 +3716,55 @@ used to create both network servers and clients.")
(home-page "http://rubyeventmachine.com")
(license (list license:ruby license:gpl3)))) ; GPLv3 only AFAICT
(define-public ruby-ruby-engine
(package
(name "ruby-ruby-engine")
(version "1.0.1")
(source
(origin
(method url-fetch)
(uri (rubygems-uri "ruby_engine" version))
(sha256
(base32
"1d0sd4q50zkcqhr395wj1wpn2ql52r0fpwhzjfvi1bljml7k546v"))))
(build-system ruby-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(add-before 'check 'clean-up
(lambda _
(delete-file "Gemfile.lock")
(substitute* "ruby_engine.gemspec"
;; Remove unnecessary imports that would entail further
;; dependencies.
((".*<rdoc.*") "")
((".*<rubygems-tasks.*") "")
;; Remove extraneous .gem file
(("\\\"pkg/ruby_engine-1.0.0.gem\\\",") "")
;; Soften rake dependency
(("%q<rake>.freeze, \\[\\\"~> 10.0\\\"\\]")
"%q<rake>.freeze, [\">= 10.0\"]")
;; Soften the rspec dependency
(("%q<rspec>.freeze, \\[\\\"~> 2.4\\\"\\]")
"%q<rspec>.freeze, [\">= 2.4\"]"))
(substitute* "Rakefile"
(("require 'rubygems/tasks'") "")
(("Gem::Tasks.new") ""))
;; Remove extraneous .gem file that otherwise gets installed.
(delete-file "pkg/ruby_engine-1.0.0.gem")
#t)))))
(native-inputs
`(("bundler" ,bundler)
("ruby-rake" ,ruby-rake)
("ruby-rspec" ,ruby-rspec)))
(synopsis "Simplifies checking for Ruby implementation")
(description
"@code{ruby_engine} provides an RubyEngine class that can be used to
check which implementation of Ruby is in use. It can provide the interpreter
name and provides query methods such as @{RubyEngine.mri?}.")
(home-page "https://github.com/janlelis/ruby_engine")
(license license:expat)))
(define-public ruby-turn
(package
(name "ruby-turn")
@ -4721,3 +4960,24 @@ thing this library does today is convert org-mode files to HTML or Textile or
Markdown.")
(home-page "https://github.com/wallyqs/org-ruby")
(license license:expat)))
(define-public ruby-rake
(package
(name "ruby-rake")
(version "12.3.0")
(source
(origin
(method url-fetch)
(uri (rubygems-uri "rake" version))
(sha256
(base32
"190p7cs8zdn07mjj6xwwsdna3g0r98zs4crz7jh2j2q5b0nbxgjf"))))
(build-system ruby-build-system)
(native-inputs
`(("bundler" ,bundler)))
(synopsis "Rake is a Make-like program implemented in Ruby")
(description
"Rake is a Make-like program where tasks and dependencies are specified
in standard Ruby syntax.")
(home-page "https://github.com/ruby/rake")
(license license:expat)))

4
gnu/packages/video.scm
View File

@ -1158,7 +1158,7 @@ access to mpv's powerful playback capabilities.")
(define-public youtube-dl
(package
(name "youtube-dl")
(version "2018.03.10")
(version "2018.03.14")
(source (origin
(method url-fetch)
(uri (string-append "https://yt-dl.org/downloads/"
@ -1166,7 +1166,7 @@ access to mpv's powerful playback capabilities.")
version ".tar.gz"))
(sha256
(base32
"1ibmz91anli1vzkgw2i3h4wf1i8arzd74730ylwcwyg3375xryjb"))))
"0j8j797gqc29fd5ra3cjvwkp8dgvigdydsj0zzjs05zccfqrj9lh"))))
(build-system python-build-system)
(arguments
;; The problem here is that the directory for the man page and completion

1
gnu/system/vm.scm
View File

@ -144,6 +144,7 @@ made available under the /xchg CIFS share."
(initrd (if initrd ; use the default initrd?
(return initrd)
(base-initrd %linux-vm-file-systems
#:on-error 'backtrace
#:linux linux
#:linux-modules %base-initrd-modules
#:qemu-networking? #t))))

2
guix/git-download.scm
View File

@ -109,7 +109,7 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f."
;; grep, etc. to be in $PATH.
(set-path-environment-variable "PATH" '("bin")
(match '#+inputs
(((names dirs) ...)
(((names dirs outputs ...) ...)
dirs)))
(or (git-fetch (getenv "git url") (getenv "git commit")

124
guix/glob.scm
View File

@ -18,80 +18,120 @@
(define-module (guix glob)
#:use-module (ice-9 match)
#:export (compile-glob-pattern
#:export (string->sglob
compile-sglob
string->compiled-sglob
glob-match?))
;;; Commentary:
;;;
;;; This is a minimal implementation of "glob patterns" (info "(libc)
;;; Globbbing"). It is currently limited to simple patterns and does not
;;; support braces and square brackets, for instance.
;;; support braces, for instance.
;;;
;;; Code:
(define (wildcard-indices str)
"Return the list of indices in STR where wildcards can be found."
(let loop ((index 0)
(result '()))
(if (= index (string-length str))
(reverse result)
(loop (+ 1 index)
(case (string-ref str index)
((#\? #\*) (cons index result))
(else result))))))
(define (parse-bracket chars)
"Parse CHARS, a list of characters that extracted from a '[...]' sequence."
(match chars
((start #\- end)
`(range ,start ,end))
(lst
`(set ,@lst))))
(define (compile-glob-pattern str)
"Return an sexp that represents the compiled form of STR, a glob pattern
such as \"foo*\" or \"foo??bar\"."
(define (string->sglob str)
"Return an sexp, called an \"sglob\", that represents the compiled form of
STR, a glob pattern such as \"foo*\" or \"foo??bar\"."
(define flatten
(match-lambda
(((? string? str)) str)
(x x)))
(let loop ((index 0)
(indices (wildcard-indices str))
(define (cons-string chars lst)
(match chars
(() lst)
(_ (cons (list->string (reverse chars)) lst))))
(let loop ((chars (string->list str))
(pending '())
(brackets 0)
(result '()))
(match indices
(match chars
(()
(flatten (cond ((zero? index)
(list str))
((= index (string-length str))
(reverse result))
(else
(reverse (cons (string-drop str index)
result))))))
((wildcard-index . rest)
(let ((wildcard (match (string-ref str wildcard-index)
(flatten (reverse (if (null? pending)
result
(cons-string pending result)))))
(((and chr (or #\? #\*)) . rest)
(let ((wildcard (match chr
(#\? '?)
(#\* '*))))
(match (substring str index wildcard-index)
("" (loop (+ 1 wildcard-index)
rest
(cons wildcard result)))
(str (loop (+ 1 wildcard-index)
rest
(cons* wildcard str result)))))))))
(if (zero? brackets)
(loop rest '() 0
(cons* wildcard (cons-string pending result)))
(loop rest (cons chr pending) brackets result))))
((#\[ . rest)
(if (zero? brackets)
(loop rest '() (+ 1 brackets)
(cons-string pending result))
(loop rest (cons #\[ pending) (+ 1 brackets) result)))
((#\] . rest)
(cond ((zero? brackets)
(error "unexpected closing bracket" str))
((= 1 brackets)
(loop rest '() 0
(cons (parse-bracket (reverse pending)) result)))
(else
(loop rest (cons #\] pending) (- brackets 1) result))))
((chr . rest)
(loop rest (cons chr pending) brackets result)))))
(define (compile-sglob sglob)
"Compile SGLOB into a more efficient representation."
(if (string? sglob)
sglob
(let loop ((sglob sglob)
(result '()))
(match sglob
(()
(reverse result))
(('? . rest)
(loop rest (cons char-set:full result)))
((('range start end) . rest)
(loop rest (cons (ucs-range->char-set
(char->integer start)
(+ 1 (char->integer end)))
result)))
((('set . chars) . rest)
(loop rest (cons (list->char-set chars) result)))
((head . rest)
(loop rest (cons head result)))))))
(define string->compiled-sglob
(compose compile-sglob string->sglob))
(define (glob-match? pattern str)
"Return true if STR matches PATTERN, a compiled glob pattern as returned by
'compile-glob-pattern'."
'compile-sglob'."
(let loop ((pattern pattern)
(str str))
(match pattern
((? string? literal) (string=? literal str))
(((? string? one)) (string=? one str))
(('*) #t)
(('?) (= 1 (string-length str)))
(() #t)
((? string? literal)
(string=? literal str))
(()
(string-null? str))
(('*)
#t)
(('* suffix . rest)
(match (string-contains str suffix)
(#f #f)
(index (loop rest
(string-drop str
(+ index (string-length suffix)))))))
(('? . rest)
(((? char-set? cs) . rest)
(and (>= (string-length str) 1)
(loop rest (string-drop str 1))))
(let ((chr (string-ref str 0)))
(and (char-set-contains? cs chr)
(loop rest (string-drop str 1))))))
((prefix . rest)
(and (string-prefix? prefix str)
(loop rest (string-drop str (string-length prefix))))))))

15
guix/import/elpa.scm
View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -190,7 +190,7 @@ include VERSION."
url)))
(_ #f))))
(define* (elpa-package->sexp pkg)
(define* (elpa-package->sexp pkg #:optional license)
"Return the `package' S-expression for the Emacs package PKG, a record of
type '<elpa-package>'."
@ -234,12 +234,17 @@ type '<elpa-package>'."
(home-page ,(elpa-package-home-page pkg))
(synopsis ,(elpa-package-synopsis pkg))
(description ,(elpa-package-description pkg))
(license license:gpl3+))))
(license ,license))))
(define* (elpa->guix-package name #:optional (repo 'gnu))
"Fetch the package NAME from REPO and produce a Guix package S-expression."
(let ((pkg (fetch-elpa-package name repo)))
(and=> pkg elpa-package->sexp)))
(match (fetch-elpa-package name repo)
(#f #f)
(package
;; ELPA is known to contain only GPLv3+ code. Other repos may contain
;; code under other license but there's no license metadata.
(let ((license (and (eq? 'gnu repo) 'license:gpl3+)))
(elpa-package->sexp package license)))))
;;;

11
tests/elpa.scm
View File

@ -81,6 +81,13 @@ information about package NAME. (Function 'elpa-package-info'.)"
auctex-readme-mock
url)))
(_ #f)))))
(mock
((guix build download) url-fetch
(lambda (url file . _)
(call-with-output-file file
(lambda (port)
(display "fake tarball" port)))))
(match (elpa->guix-package pkg)
(('package
('name "emacs-auctex")
@ -89,7 +96,7 @@ information about package NAME. (Function 'elpa-package-info'.)"
('origin
('method 'url-fetch)
('uri ('string-append
"http://elpa.gnu.org/packages/auctex-" 'version ".tar"))
"https://elpa.gnu.org/packages/auctex-" 'version ".tar"))
('sha256 ('base32 (? string? hash)))))
('build-system 'emacs-build-system)
('home-page "http://www.gnu.org/software/auctex/")
@ -98,7 +105,7 @@ information about package NAME. (Function 'elpa-package-info'.)"
('license 'license:gpl3+))
#t)
(x
(pk 'fail x #f)))))
(pk 'fail x #f))))))
(test-assert "elpa->guix-package test 1"
(eval-test-with-elpa "auctex"))

67
tests/glob.scm
View File

@ -23,36 +23,47 @@
(test-begin "glob")
(test-equal "compile-glob-pattern, no wildcards"
"foo"
(compile-glob-pattern "foo"))
(define-syntax test-string->sglob
(syntax-rules (=>)
((_ pattern => result rest ...)
(begin
(test-equal (format #f "string->sglob, ~s" pattern)
result
(string->sglob pattern))
(test-string->sglob rest ...)))
((_)
#t)))
(test-equal "compile-glob-pattern, Kleene star"
'("foo" * "bar")
(compile-glob-pattern "foo*bar"))
(define-syntax test-glob-match
(syntax-rules (matches and not)
((_ (pattern-string matches strings ... (and not others ...)) rest ...)
(begin
(test-assert (format #f "glob-match? ~s" pattern-string)
(let ((pattern (string->compiled-sglob pattern-string)))
(and (glob-match? pattern strings) ...
(not (glob-match? pattern others)) ...)))
(test-glob-match rest ...)))
((_)
#t)))
(test-equal "compile-glob-pattern, question mark"
'(? "foo" *)
(compile-glob-pattern "?foo*"))
(test-string->sglob
"foo" => "foo"
"?foo*" => '(? "foo" *)
"foo[1-5]" => '("foo" (range #\1 #\5))
"foo[abc]bar" => '("foo" (set #\a #\b #\c) "bar")
"foo[a[b]c]bar" => '("foo" (set #\a #\[ #\b #\] #\c) "bar")
"[123]x" => '((set #\1 #\2 #\3) "x")
"[a-z]" => '((range #\a #\z)))
(test-assert "literal match"
(let ((pattern (compile-glob-pattern "foo")))
(and (glob-match? pattern "foo")
(not (glob-match? pattern "foobar"))
(not (glob-match? pattern "barfoo")))))
(test-assert "trailing star"
(let ((pattern (compile-glob-pattern "foo*")))
(and (glob-match? pattern "foo")
(glob-match? pattern "foobar")
(not (glob-match? pattern "xfoo")))))
(test-assert "question marks"
(let ((pattern (compile-glob-pattern "foo??bar")))
(and (glob-match? pattern "fooxxbar")
(glob-match? pattern "fooZZbar")
(not (glob-match? pattern "foobar"))
(not (glob-match? pattern "fooxxxbar"))
(not (glob-match? pattern "fooxxbarzz")))))
(test-glob-match
("foo" matches "foo" (and not "foobar" "barfoo"))
("foo*" matches "foo" "foobar" (and not "xfoo"))
("foo??bar" matches "fooxxbar" "fooZZbar"
(and not "foobar" "fooxxxbar" "fooxxbarzz"))
("foo?" matches "foox" (and not "fooxx"))
("ab[0-9]c" matches "ab0c" "ab7c" "ab9c"
(and not "ab-c" "ab00c" "ab3"))
("ab[cdefg]" matches "abc" "abd" "abg"
(and not "abh" "abcd" "ab[")))
(test-end "glob")