01/01: guix: lint: Check descriptions for trademark signs.

[Eric Bavier]

bavier pushed a commit to branch master
in repository guix.

commit 83f18e06530f025df9f6c5059bfe261a1291a24f
Author: Eric Bavier <address@hidden>
Date:   Tue Aug 23 02:08:02 2016 -0500

    guix: lint: Check descriptions for trademark signs.
    
    * guix/scripts/lint.scm (check-description-style): Emit a warning if
    trademark signs found in description.
    * tests/lint.scm (description: may not contain trademark signs): Add
    test.
---
 guix/scripts/lint.scm |   13 +++++++++++++
 tests/lint.scm        |   16 +++++++++++++++-
 2 files changed, 28 insertions(+), 1 deletion(-)

diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 51191e7..eac3214 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -161,6 +161,18 @@ markup is valid return a plain-text version of 
DESCRIPTION, otherwise #f."
                       'description)
         #f)))
 
+  (define (check-trademarks description)
+    "Check that DESCRIPTION does not contain '™' or '®' characters.  See
+http://www.gnu.org/prep/standards/html_node/Trademarks.html.";
+    (match (string-index description (char-set #\™ #\®))
+      ((and (? number?) index)
+       (emit-warning package
+                     (format #f (_ "description should not contain ~
+trademark sign '~a' at ~d")
+                             (string-ref description index) index)
+                     'description))
+      (else #t)))
+
   (define (check-proper-start description)
     (unless (or (properly-starts-sentence? description)
                 (string-prefix-ci? (package-name package) description))
@@ -191,6 +203,7 @@ by two spaces; possible infraction~p at ~{~a~^, ~}")
     (if (string? description)
         (begin
           (check-not-empty description)
+          (check-trademarks description)
           ;; Use raw description for this because Texinfo rendering
           ;; automatically fixes end of sentence space.
           (check-end-of-sentence-space description)
diff --git a/tests/lint.scm b/tests/lint.scm
index 770f43e..df69d2b 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2013 Cyril Roelandt <address@hidden>
-;;; Copyright © 2014, 2015 Eric Bavier <address@hidden>
+;;; Copyright © 2014, 2015, 2016 Eric Bavier <address@hidden>
 ;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <address@hidden>
 ;;; Copyright © 2015, 2016 Mathieu Lirzin <address@hidden>
 ;;;
@@ -203,6 +203,20 @@ string) on HTTP requests."
                    "E.g. Foo, i.e. Bar resp. Baz (a.k.a. DVD)."))))
        (check-description-style pkg)))))
 
+(test-assert "description: may not contain trademark signs"
+  (and (->bool
+        (string-contains (with-warnings
+                           (let ((pkg (dummy-package "x"
+                                        (description "Does The Right 
Thing™"))))
+                             (check-description-style pkg)))
+                         "should not contain trademark sign"))
+       (->bool
+        (string-contains (with-warnings
+                           (let ((pkg (dummy-package "x"
+                                        (description "Works with Format®"))))
+                             (check-description-style pkg)))
+                         "should not contain trademark sign"))))
+
 (test-assert "synopsis: not a string"
   (->bool
    (string-contains (with-warnings