ui: Support Texinfo markup in package synopses.

* guix/ui.scm (package-field-string): New procedure.
(package-description-string): Use it.
(package-synopsis-string): New procedure.
(package->recutils): Use it.
* guix/scripts/lint.scm (check-synopsis-style)[check-texinfo-markup]:
New procedure.  Use it in checks.
* tests/lint.scm: Test it.
* gnu/packages/perl.scm (perl-try-tiny)[synopsis]: Adjust for the
Texinfo markup.
This commit is contained in:
Alex Kost 2017-03-20 13:41:41 +03:00
parent 2fccc0d193
commit 689db38e34
No known key found for this signature in database
GPG Key ID: 82460C082A0EE98F
4 changed files with 41 additions and 8 deletions

View File

@ -7684,7 +7684,7 @@ Tree::Simple::Visitor::* objects.")
"068vdbpacfawc3lkfs0b82xxl27h3l0gj14iada3vlwk8rps9yv0")))) "068vdbpacfawc3lkfs0b82xxl27h3l0gj14iada3vlwk8rps9yv0"))))
(build-system perl-build-system) (build-system perl-build-system)
(home-page "http://search.cpan.org/dist/Try-Tiny") (home-page "http://search.cpan.org/dist/Try-Tiny")
(synopsis "Minimal try/catch with proper preservation of $@") (synopsis "Minimal try/catch with proper preservation of $@@")
(description "This module provides bare bones try/catch/finally statements (description "This module provides bare bones try/catch/finally statements
that are designed to minimize common mistakes with eval blocks, and nothing that are designed to minimize common mistakes with eval blocks, and nothing
else.") else.")

View File

@ -5,6 +5,7 @@
;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org> ;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2016 Danny Milosavljevic <dannym+a@scratchpost.org> ;;; Copyright © 2016 Danny Milosavljevic <dannym+a@scratchpost.org>
;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com> ;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -347,10 +348,25 @@ the synopsis")
(_ "synopsis should not start with the package name") (_ "synopsis should not start with the package name")
'synopsis))) 'synopsis)))
(define (check-texinfo-markup synopsis)
"Check that SYNOPSIS can be parsed as a Texinfo fragment. If the
markup is valid return a plain-text version of SYNOPSIS, otherwise #f."
(catch #t
(lambda () (texi->plain-text synopsis))
(lambda (keys . args)
(emit-warning package
(_ "Texinfo markup in synopsis is invalid")
'synopsis)
#f)))
(define checks (define checks
(list check-not-empty check-proper-start check-final-period (list check-not-empty
check-start-article check-start-with-package-name check-proper-start
check-synopsis-length)) check-final-period
check-start-article
check-start-with-package-name
check-synopsis-length
check-texinfo-markup))
(match (package-synopsis package) (match (package-synopsis package)
((? string? synopsis) ((? string? synopsis)

View File

@ -4,7 +4,7 @@
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2014 Cyril Roelandt <tipecaml@gmail.com> ;;; Copyright © 2014 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2014 Cyrill Schenkel <cyrill.schenkel@gmail.com> ;;; Copyright © 2014 Cyrill Schenkel <cyrill.schenkel@gmail.com>
;;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com> ;;; Copyright © 2014, 2015, 2017 Alex Kost <alezost@gmail.com>
;;; Copyright © 2015 David Thompson <davet@gnu.org> ;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org> ;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2016 Roel Janssen <roel@gnu.org> ;;; Copyright © 2016 Roel Janssen <roel@gnu.org>
@ -81,6 +81,7 @@
fill-paragraph fill-paragraph
texi->plain-text texi->plain-text
package-description-string package-description-string
package-synopsis-string
string->recutils string->recutils
package->recutils package->recutils
package-specification->name+version+output package-specification->name+version+output
@ -848,10 +849,18 @@ converted to a space; sequences of more than one line break are preserved."
(with-fluids ((%default-port-encoding "UTF-8")) (with-fluids ((%default-port-encoding "UTF-8"))
(stexi->plain-text (texi-fragment->stexi str)))) (stexi->plain-text (texi-fragment->stexi str))))
(define (package-field-string package field-accessor)
"Return a plain-text representation of PACKAGE field."
(and=> (field-accessor package)
(compose texi->plain-text P_)))
(define (package-description-string package) (define (package-description-string package)
"Return a plain-text representation of PACKAGE description field." "Return a plain-text representation of PACKAGE description field."
(and=> (package-description package) (package-field-string package package-description))
(compose texi->plain-text P_)))
(define (package-synopsis-string package)
"Return a plain-text representation of PACKAGE synopsis field."
(package-field-string package package-synopsis))
(define (string->recutils str) (define (string->recutils str)
"Return a version of STR where newlines have been replaced by newlines "Return a version of STR where newlines have been replaced by newlines
@ -914,7 +923,7 @@ WIDTH columns."
(string-map (match-lambda (string-map (match-lambda
(#\newline #\space) (#\newline #\space)
(chr chr)) (chr chr))
(or (and=> (package-synopsis p) P_) (or (and=> (package-synopsis-string p) P_)
""))) "")))
(format port "~a~2%" (format port "~a~2%"
(string->recutils (string->recutils

View File

@ -4,6 +4,7 @@
;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org> ;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com> ;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -167,6 +168,13 @@
(check-synopsis-style pkg))) (check-synopsis-style pkg)))
"synopsis should not be empty"))) "synopsis should not be empty")))
(test-assert "synopsis: valid Texinfo markup"
(->bool
(string-contains
(with-warnings
(check-synopsis-style (dummy-package "x" (synopsis "Bad $@ texinfo"))))
"Texinfo markup in synopsis is invalid")))
(test-assert "synopsis: does not start with an upper-case letter" (test-assert "synopsis: does not start with an upper-case letter"
(->bool (->bool
(string-contains (with-warnings (string-contains (with-warnings