;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017, 2018 Ludovic Courtès ;;; Copyright © 2020 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. ;;; ;;; GNU Guix is free software; you can redistribute it and/or modify it ;;; under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 3 of the License, or (at ;;; your option) any later version. ;;; ;;; GNU Guix is distributed in the hope that it will be useful, but ;;; WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see . ;;; Commentary: ;;; ;;; This scripts updates the definition of the 'guix' package in Guix for the ;;; current commit. It requires Git to be installed. ;;; ;;; Code: (use-modules (guix) (guix ui) (guix git-download)

path: root/emacs/guix-emacs.el

diff options

Diffstat (limited to 'emacs/guix-emacs.el')

0 files changed, 0 insertions, 0 deletions

tax-rule (with-input-pipe-to-string prog arg ...) (let* ((input-pipe (open-pipe* OPEN_READ prog arg ...)) (output (get-string-all input-pipe)) (exit-val (status:exit-val (close-pipe input-pipe)))) (unless (zero? exit-val) (error (format #f "Command ~s exited with non-zero exit status: ~s" (string-join (list prog arg ...)) exit-val))) (string-trim-both output))) (define (find-origin-remote) "Find the name of the git remote with the Savannah Guix git repo URL." (and-let* ((remotes (string-split (with-input-pipe-to-string "git" "remote" "-v") #\newline)) (origin-entry (find (cut string-match %savannah-guix-git-repo-push-url-regexp <>) remotes))) (first (string-split origin-entry #\tab)))) (define (commit-already-pushed? remote commit) "True if COMMIT is found in the REMOTE repository." (not (string-null? (with-input-pipe-to-string "git" "branch" "-r" "--contains" commit (string-append remote "/master"))))) (define (keep-source-in-store store source) "Add SOURCE to the store under the name that the 'guix' package expects." ;; Add SOURCE to the store, but this time under the real name used in the ;; 'origin'. This allows us to build the package without having to make a ;; real checkout; thus, it also works when working on a private branch. (reload-module (resolve-module '(gnu packages package-management))) (let* ((source (add-to-store store (origin-file-name (package-source guix)) #t "sha256" source #:select? (git-predicate source))) (root (store-path-package-name source))) ;; Add an indirect GC root for SOURCE in the current directory. (false-if-exception (delete-file root)) (symlink source root) (add-indirect-root store (string-append (getcwd) "/" root)) (info (G_ "source code kept in ~a (GC root: ~a)~%") source root))) (define (main . args) (match args ((commit version) (with-directory-excursion %top-srcdir (or (getenv "GUIX_ALLOW_ME_TO_USE_PRIVATE_COMMIT") (let ((remote (find-origin-remote))) (unless remote (leave (G_ "Failed to find the origin git remote.~%"))) (commit-already-pushed? remote commit)) (leave (G_ "Commit ~a is not pushed upstream. Aborting.~%") commit)) (call-with-temporary-git-worktree commit (lambda (tmp-directory) (let* ((hash (nix-base32-string->bytevector (string-trim-both (with-output-to-string (lambda () (guix-hash "-rx" tmp-directory)))))) (location (package-definition-location)) (old-hash (content-hash-value (origin-hash (package-source guix))))) (edit-expression location (update-definition commit hash #:old-hash old-hash #:version version)) ;; When GUIX_ALLOW_ME_TO_USE_PRIVATE_COMMIT is set, the sources are ;; added to the store. This is used as part of 'make release'. (when (getenv "GUIX_ALLOW_ME_TO_USE_PRIVATE_COMMIT") (with-store store (keep-source-in-store store tmp-directory)))))))) ((commit) ;; Automatically deduce the version and revision numbers. (main commit #f)))) (apply main (cdr (command-line)))


context:
space:
mode: