(define (list-checkers-and-exit)
;; Print information about all available checkers and exit.
- (format #t (_ "Available checkers:~%"))
+ (format #t (G_ "Available checkers:~%"))
(for-each (lambda (checker)
(format #t "- ~a: ~a~%"
(lint-checker-name checker)
- (_ (lint-checker-description checker))))
+ (G_ (lint-checker-description checker))))
%checkers)
(exit 0))
(define (check-not-empty description)
(when (string-null? description)
(emit-warning package
- (_ "description should not be empty")
+ (G_ "description should not be empty")
'description)))
(define (check-texinfo-markup description)
(lambda () (texi->plain-text description))
(lambda (keys . args)
(emit-warning package
- (_ "Texinfo markup in description is invalid")
+ (G_ "Texinfo markup in description is invalid")
'description)
#f)))
(match (string-index description (char-set #\™ #\®))
((and (? number?) index)
(emit-warning package
- (format #f (_ "description should not contain ~
+ (format #f (G_ "description should not contain ~
trademark sign '~a' at ~d")
(string-ref description index) index)
'description))
;; TRANSLATORS: '@code' is Texinfo markup and must be kept
;; as is.
- (_ "use @code or similar ornament instead of quotes")
+ (G_ "use @code or similar ornament instead of quotes")
'description)))
(define (check-proper-start description)
(unless (or (properly-starts-sentence? description)
(string-prefix-ci? (package-name package) description))
(emit-warning package
- (_ "description should start with an upper-case letter or digit")
+ (G_ "description should start with an upper-case letter or digit")
'description)))
(define (check-end-of-sentence-space description)
r (cons (match:start m) r)))))))
(unless (null? infractions)
(emit-warning package
- (format #f (_ "sentences in description should be followed ~
+ (format #f (G_ "sentences in description should be followed ~
by two spaces; possible infraction~p at ~{~a~^, ~}")
(length infractions)
infractions)
(and=> (check-texinfo-markup description)
check-proper-start))
(emit-warning package
- (format #f (_ "invalid description: ~s") description)
+ (format #f (G_ "invalid description: ~s") description)
'description))))
(define (package-input-intersection inputs-to-check input-names)
(for-each (lambda (input)
(emit-warning
package
- (format #f (_ "'~a' should probably be a native input")
+ (format #f (G_ "'~a' should probably be a native input")
input)
'inputs-to-check))
(package-input-intersection inputs input-names))))
(emit-warning
package
(format #f
- (_ "'~a' should probably not be an input at all")
+ (G_ "'~a' should probably not be an input at all")
input)))
(package-input-intersection (package-direct-inputs package)
input-names))))
(define (check-not-empty synopsis)
(when (string-null? synopsis)
(emit-warning package
- (_ "synopsis should not be empty")
+ (G_ "synopsis should not be empty")
'synopsis)))
(define (check-final-period synopsis)
(when (and (string-suffix? "." synopsis)
(not (string-suffix? "etc." synopsis)))
(emit-warning package
- (_ "no period allowed at the end of the synopsis")
+ (G_ "no period allowed at the end of the synopsis")
'synopsis)))
(define check-start-article
(when (or (string-prefix-ci? "A " synopsis)
(string-prefix-ci? "An " synopsis))
(emit-warning package
- (_ "no article allowed at the beginning of \
+ (G_ "no article allowed at the beginning of \
the synopsis")
'synopsis)))))
(define (check-synopsis-length synopsis)
(when (>= (string-length synopsis) 80)
(emit-warning package
- (_ "synopsis should be less than 80 characters long")
+ (G_ "synopsis should be less than 80 characters long")
'synopsis)))
(define (check-proper-start synopsis)
(unless (properly-starts-sentence? synopsis)
(emit-warning package
- (_ "synopsis should start with an upper-case letter or digit")
+ (G_ "synopsis should start with an upper-case letter or digit")
'synopsis)))
(define (check-start-with-package-name synopsis)
(when (and (regexp-exec (package-name-regexp package) synopsis)
(not (starts-with-abbreviation? synopsis)))
(emit-warning package
- (_ "synopsis should not start with the package name")
+ (G_ "synopsis should not start with the package name")
'synopsis)))
(define (check-texinfo-markup synopsis)
(lambda () (texi->plain-text synopsis))
(lambda (keys . args)
(emit-warning package
- (_ "Texinfo markup in synopsis is invalid")
+ (G_ "Texinfo markup in synopsis is invalid")
'synopsis)
#f)))
(proc synopsis))
checks))
(invalid
- (emit-warning package (format #f (_ "invalid synopsis: ~s") invalid)
+ (emit-warning package (format #f (G_ "invalid synopsis: ~s") invalid)
'synopsis))))
(define* (probe-uri uri #:key timeout)
(begin
(emit-warning package
(format #f
- (_ "URI ~a returned \
+ (G_ "URI ~a returned \
suspiciously small file (~a bytes)")
(uri->string uri)
length))
(begin
(emit-warning package
(format #f
- (_ "URI ~a not reachable: ~a (~s)")
+ (G_ "URI ~a not reachable: ~a (~s)")
(uri->string uri)
(response-code argument)
(response-reason-phrase argument))
(('error port command code message)
(emit-warning package
(format #f
- (_ "URI ~a not reachable: ~a (~s)")
+ (G_ "URI ~a not reachable: ~a (~s)")
(uri->string uri)
code (string-trim-both message)))
#f)))
((getaddrinfo-error)
(emit-warning package
(format #f
- (_ "URI ~a domain not found: ~a")
+ (G_ "URI ~a domain not found: ~a")
(uri->string uri)
(gai-strerror (car argument)))
field)
((system-error)
(emit-warning package
(format #f
- (_ "URI ~a unreachable: ~a")
+ (G_ "URI ~a unreachable: ~a")
(uri->string uri)
(strerror
(system-error-errno
#f)
((tls-certificate-error)
(emit-warning package
- (format #f (_ "TLS certificate error: ~a")
+ (format #f (G_ "TLS certificate error: ~a")
(tls-certificate-error-string argument))))
((invalid-http-response gnutls-error)
;; Probably a misbehaving server; ignore.
(unless (or (string-contains (package-name package) "bootstrap")
(string=? (package-name package) "ld-wrapper"))
(emit-warning package
- (_ "invalid value for home page")
+ (G_ "invalid value for home page")
'home-page)))
(else
- (emit-warning package (format #f (_ "invalid home page URL: ~s")
+ (emit-warning package (format #f (G_ "invalid home page URL: ~s")
(package-home-page package))
'home-page)))))
'()))
(emit-warning
package
- (_ "file names of patches should start with the package name")
+ (G_ "file names of patches should start with the package name")
'patch-file-names))))
(define (escape-quotes str)
(or (not (string? downstream))
(not (string=? upstream downstream))))
(format (guix-warning-port)
- (_ "~a: ~a: proposed synopsis: ~s~%")
+ (G_ "~a: ~a: proposed synopsis: ~s~%")
(location->string loc) (package-full-name package)
upstream)))
(not (string=? (fill-paragraph upstream 100)
(fill-paragraph downstream 100)))))
(format (guix-warning-port)
- (_ "~a: ~a: proposed description:~% \"~a\"~%")
+ (G_ "~a: ~a: proposed description:~% \"~a\"~%")
(location->string loc) (package-full-name package)
(fill-paragraph (escape-quotes upstream) 77 7)))))))
;; where *all* the URIs are unreachable.
(unless success?
(emit-warning package
- (_ "all the source URIs are unreachable:")
+ (G_ "all the source URIs are unreachable:")
'source)
(for-each (lambda (warning)
(display warning (guix-warning-port)))
(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")
+ (G_ "the source file name should contain the package name")
'source))))
(define (check-mirror-url package)
(loop rest))
(prefix
(emit-warning package
- (format #f (_ "URL should be \
+ (format #f (G_ "URL should be \
'mirror://~a/~a'")
mirror-id
(string-drop uri (string-length prefix)))
(lambda ()
(guard (c ((nix-protocol-error? c)
(emit-warning package
- (format #f (_ "failed to create derivation: ~a")
+ (format #f (G_ "failed to create derivation: ~a")
(nix-protocol-error-message c))))
((message-condition? c)
(emit-warning package
- (format #f (_ "failed to create derivation: ~a")
+ (format #f (G_ "failed to create derivation: ~a")
(condition-message c)))))
(with-store store
;; Disable grafts since it can entail rebuilds.
(package-derivation store replacement #:graft? #f))))))
(lambda args
(emit-warning package
- (format #f (_ "failed to create derivation: ~s~%")
+ (format #f (G_ "failed to create derivation: ~s~%")
args)))))
(define (check-license package)
((? license?) ...))
#t)
(x
- (emit-warning package (_ "invalid license field")
+ (emit-warning package (G_ "invalid license field")
'license))))
(define (patch-file-name patch)
or HTTP errors. This allows network-less operation and makes problems with
the NIST server non-fatal.."
(guard (c ((http-get-error? c)
- (warning (_ "failed to retrieve CVE vulnerabilities \
+ (warning (G_ "failed to retrieve CVE vulnerabilities \
from ~s: ~a (~s)~%")
(uri->string (http-get-error-uri c))
(http-get-error-code c)
(http-get-error-reason c))
- (warning (_ "assuming no CVE vulnerabilities~%"))
+ (warning (G_ "assuming no CVE vulnerabilities~%"))
'()))
(catch #t
(lambda ()
(current-vulnerabilities))
(match-lambda*
(('getaddrinfo-error errcode)
- (warning (_ "failed to lookup NIST host: ~a~%")
+ (warning (G_ "failed to lookup NIST host: ~a~%")
(gai-strerror errcode))
- (warning (_ "assuming no CVE vulnerabilities~%"))
+ (warning (G_ "assuming no CVE vulnerabilities~%"))
'())
(('tls-certificate-error args ...)
- (warning (_ "TLS certificate error: ~a")
+ (warning (G_ "TLS certificate error: ~a")
(tls-certificate-error-string args))
- (warning (_ "assuming no CVE vulnerabilities~%"))
+ (warning (G_ "assuming no CVE vulnerabilities~%"))
'())
(args
(apply throw args))))))
vulnerabilities)))
(unless (null? unpatched)
(emit-warning package
- (format #f (_ "probably vulnerable to ~a")
+ (format #f (G_ "probably vulnerable to ~a")
(string-join (map vulnerability-id unpatched)
", ")))))))))
(#f #t)
(index
(emit-warning package
- (format #f (_ "tabulation on line ~a, column ~a")
+ (format #f (G_ "tabulation on line ~a, column ~a")
line-number index)))))
(define (report-trailing-white-space package line line-number)
(string=? line (string #\page)))
(emit-warning package
(format #f
- (_ "trailing white space on line ~a")
+ (G_ "trailing white space on line ~a")
line-number))))
(define (report-long-line package line line-number)
;; much noise.
(when (> (string-length line) 90)
(emit-warning package
- (format #f (_ "line ~a is way too long (~a characters)")
+ (format #f (G_ "line ~a is way too long (~a characters)")
line-number (string-length line)))))
(define %hanging-paren-rx
(when (regexp-exec %hanging-paren-rx line)
(emit-warning package
(format #f
- (_ "line ~a: parentheses feel lonely, \
+ (G_ "line ~a: parentheses feel lonely, \
move to the previous or next line")
line-number))))
'())
(define (show-help)
- (display (_ "Usage: guix lint [OPTION]... [PACKAGE]...
+ (display (G_ "Usage: guix lint [OPTION]... [PACKAGE]...
Run a set of checkers on the specified package; if none is specified,
run the checkers on all packages.\n"))
- (display (_ "
+ (display (G_ "
-c, --checkers=CHECKER1,CHECKER2...
only run the specified checkers"))
- (display (_ "
+ (display (G_ "
-h, --help display this help and exit"))
- (display (_ "
+ (display (G_ "
-l, --list-checkers display the list of available lint checkers"))
- (display (_ "
+ (display (G_ "
-V, --version display version information and exit"))
(newline)
(show-bug-report-information))
(unless (memq c
(map lint-checker-name
%checkers))
- (leave (_ "~a: invalid checker~%") c)))
+ (leave (G_ "~a: invalid checker~%") c)))
names)
(alist-cons 'checkers
(filter (lambda (checker)
;; Return the alist of option values.
(args-fold* args %options
(lambda (opt name arg result)
- (leave (_ "~A: unrecognized option~%") name))
+ (leave (G_ "~A: unrecognized option~%") name))
(lambda (arg result)
(alist-cons 'argument arg result))
%default-options))
HCoop / jackhill / guix / guix.git / blobdiff