aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gnu/build/linux-modules.scm19
-rw-r--r--gnu/packages/cran.scm31
-rw-r--r--gnu/packages/gnome.scm4
-rw-r--r--gnu/packages/gnuzilla.scm5
-rw-r--r--gnu/packages/maths.scm34
-rw-r--r--gnu/packages/ruby.scm260
-rw-r--r--gnu/packages/video.scm4
-rw-r--r--gnu/system/vm.scm1
-rw-r--r--guix/git-download.scm2
-rw-r--r--guix/glob.scm124
-rw-r--r--guix/import/elpa.scm15
-rw-r--r--tests/elpa.scm43
-rw-r--r--tests/glob.scm67
13 files changed, 503 insertions, 106 deletions
diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index 4fe673cca2..87d2e98edf 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -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
diff --git a/gnu/packages/cran.scm b/gnu/packages/cran.scm
index 717fa7fdfa..b54ddc6b55 100644
--- a/gnu/packages/cran.scm
+++ b/gnu/packages/cran.scm
@@ -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")
diff --git a/gnu/packages/gnome.scm b/gnu/packages/gnome.scm
index 164d705ca5..6623a59bff 100644
--- a/gnu/packages/gnome.scm
+++ b/gnu/packages/gnome.scm
@@ -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)))
diff --git a/gnu/packages/gnuzilla.scm b/gnu/packages/gnuzilla.scm
index c8cec6b422..0836b89a80 100644
--- a/gnu/packages/gnuzilla.scm
+++ b/gnu/packages/gnuzilla.scm
@@ -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
diff --git a/gnu/packages/maths.scm b/gnu/packages/maths.scm
index 64fe13b9bc..51fe119712 100644
--- a/gnu/packages/maths.scm
+++ b/gnu/packages/maths.scm
@@ -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")
diff --git a/gnu/packages/ruby.scm b/gnu/packages/ruby.scm
index ee5d20955c..dcf4cda26a 100644
--- a/gnu/packages/ruby.scm
+++ b/gnu/packages/ruby.scm
@@ -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)))
diff --git a/gnu/packages/video.scm b/gnu/packages/video.scm
index f66bfa2435..0dc0ef6551 100644
--- a/gnu/packages/video.scm
+++ b/gnu/packages/video.scm
@@ -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
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index ae8780d2e1..594ba66ff4 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -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))))
diff --git a/guix/git-download.scm b/guix/git-download.scm
index 731e549b38..33f102bc6c 100644
--- a/guix/git-download.scm
+++ b/guix/git-download.scm
@@ -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")
diff --git a/guix/glob.scm b/guix/glob.scm
index 4fc5173ac0..a9fc744802 100644
--- a/guix/glob.scm
+++ b/guix/glob.scm
@@ -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))))))))
diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm
index 5d3d04ee7c..43e9eb60c9 100644
--- a/guix/import/elpa.scm
+++ b/guix/import/elpa.scm
@@ -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)))))
;;;
diff --git a/tests/elpa.scm b/tests/elpa.scm
index 46c6ac2d75..44e3914f2e 100644
--- a/tests/elpa.scm
+++ b/tests/elpa.scm
@@ -81,24 +81,31 @@ information about package NAME. (Function 'elpa-package-info'.)"
auctex-readme-mock
url)))
(_ #f)))))
- (match (elpa->guix-package pkg)
- (('package
- ('name "emacs-auctex")
- ('version "11.88.6")
- ('source
- ('origin
- ('method 'url-fetch)
- ('uri ('string-append
- "http://elpa.gnu.org/packages/auctex-" 'version ".tar"))
- ('sha256 ('base32 (? string? hash)))))
- ('build-system 'emacs-build-system)
- ('home-page "http://www.gnu.org/software/auctex/")
- ('synopsis "Integrated environment for *TeX*")
- ('description (? string?))
- ('license 'license:gpl3+))
- #t)
- (x
- (pk 'fail x #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")
+ ('version "11.88.6")
+ ('source
+ ('origin
+ ('method 'url-fetch)
+ ('uri ('string-append
+ "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/")
+ ('synopsis "Integrated environment for *TeX*")
+ ('description (? string?))
+ ('license 'license:gpl3+))
+ #t)
+ (x
+ (pk 'fail x #f))))))
(test-assert "elpa->guix-package test 1"
(eval-test-with-elpa "auctex"))
diff --git a/tests/glob.scm b/tests/glob.scm
index 033eeb10fe..3134069789 100644
--- a/tests/glob.scm
+++ b/tests/glob.scm
@@ -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")
generated by cgit v1.2.3 (git 2.45.0) at 2024-11-22 14:05:28 +0000