From 55d1f529e1a50387d6bf7d474a3cbe3839a1f885 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 16 Jun 2015 10:28:19 +0200 Subject: gnu-maintenance: Use 'home-page' as an additional hint of "GNUness". Reported by Rastus_Vernon on IRC. Fixes 'gnu-package?' for GNUcash. * guix/gnu-maintenance.scm (gnu-package?)[gnu-home-page?]: New procedure. Use it to determine whether PACKAGE is GNU. --- guix/gnu-maintenance.scm | 25 ++++++++++++++++--------- 1 file changed, 16 insertions(+), 9 deletions(-) (limited to 'guix/gnu-maintenance.scm') diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index 8d47cee487..ac83df40a3 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -192,15 +192,22 @@ network to check in GNU's database." ;; Definitely non-GNU. 'non-gnu))))) - (let ((url (and=> (package-source package) origin-uri)) - (name (package-name package))) - (case (and (string? url) (mirror-type url)) - ((gnu) #t) - ((non-gnu) #f) - (else - ;; Last resort: resort to the network. - (and (member name (map gnu-package-name (official-gnu-packages))) - #t)))))))) + (define (gnu-home-page? package) + (and=> (package-home-page package) + (lambda (url) + (and=> (uri-host (string->uri url)) + (lambda (host) + (member host '("www.gnu.org" "gnu.org"))))))) + + (or (gnu-home-page? package) + (let ((url (and=> (package-source package) origin-uri)) + (name (package-name package))) + (case (and (string? url) (mirror-type url)) + ((gnu) #t) + ((non-gnu) #f) + (else + (and (member name (map gnu-package-name (official-gnu-packages))) + #t))))))))) ;;; -- cgit v1.2.3