From mboxrd@z Thu Jan 1 00:00:00 1970 From: ericbavier@openmailbox.org Subject: [PATCH] website: packages: Anchor location url to commit id. Date: Sat, 11 Feb 2017 20:05:20 -0600 Message-ID: <20170212020520.812-1-ericbavier@openmailbox.org> Mime-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: quoted-printable Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:50162) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ccjVl-0004MS-2V for guix-devel@gnu.org; Sat, 11 Feb 2017 21:03:34 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ccjVg-0004Ff-VD for guix-devel@gnu.org; Sat, 11 Feb 2017 21:03:33 -0500 Received: from lb1.openmailbox.org ([5.79.108.160]:45223 helo=mail.openmailbox.org) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1ccjVg-0004FY-NU for guix-devel@gnu.org; Sat, 11 Feb 2017 21:03:28 -0500 List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: "Guix-devel" To: guix-devel@gnu.org Cc: Eric Bavier From: Eric Bavier * website/www/packages.scm (git-description): New variable. (location-url): Include "?id=3D..." if possible. --- website/www/packages.scm | 22 ++++++++++++++++++++-- 1 file changed, 20 insertions(+), 2 deletions(-) diff --git a/website/www/packages.scm b/website/www/packages.scm index 91784ec..30153d5 100644 --- a/website/www/packages.scm +++ b/website/www/packages.scm @@ -2,6 +2,7 @@ ;;; Copyright =C2=A9 2013, 2014, 2015, 2016, 2017 Ludovic Court=C3=A8s <= ludo@gnu.org> ;;; Copyright =C2=A9 2015 Mathieu Lirzin ;;; Copyright =C2=A9 2013 Alex Sassmannshausen +;;; Copyright =C2=A9 2017 Eric Bavier ;;; Initially written by Luis Felipe L=C3=B3pez Acevedo ;;; who waives all copyright interest on this file. ;;; @@ -35,6 +36,7 @@ #:use-module (guix base32) #:use-module ((guix download) #:select (%mirrors)) #:use-module ((guix build download) #:select (maybe-expand-mirrors)) + #:use-module (guix build utils) #:use-module (guix scripts lint) #:use-module (guix scripts challenge) #:use-module (guix scripts substitute) @@ -47,6 +49,8 @@ #:use-module (ice-9 vlist) #:use-module (ice-9 i18n) #:use-module (ice-9 format) + #:use-module (ice-9 popen) + #:use-module (ice-9 rdelim) #:use-module (srfi srfi-1) #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) @@ -82,10 +86,24 @@ (loop tail (cons* head item result)))))) =20 +(define git-description + (delay + (let* ((guix (find (lambda (p) + (file-exists? (string-append p "/guix/config.scm= "))) + %load-path)) + (pipe (with-directory-excursion guix + (open-pipe* OPEN_READ "git" "describe"))) + (desc (read-line pipe)) + (git? (close-pipe pipe))) + (and git? desc)))) + (define (location-url loc) (string-append "http://git.savannah.gnu.org/cgit/guix.git/tree/" - (location-file loc) "#n" - (number->string (location-line loc)))) + (location-file loc) + (or (and=3D> (force git-description) + (cut string-append "?id=3D" <>)) + "") + "#n" (number->string (location-line loc)))) =20 (define (source-url package) (let ((loc (package-location package))) --=20 2.11.0