emacs packages

[Federico Beffa <beffa@ieee.org>]

[-- Attachment #1: Type: text/plain, Size: 1228 bytes --]

Hi,

I would like to know what people think about having an
'emacs-build-system' to build packages imported from an ELPA
repository.  Note that the package archives provided by such a
repository are slightly different from the '.tar.gz' files that you
download from the "real" project home.  One difference is that the
former include final ".info" and "dir" files. It is likely that there
are more differences that I didn't notice due to my limited knowledge
about Emacs packages.

To be concrete about what I'm proposing, attached you find:

- An ELPA package importer
- An 'emacs-build-system'

There are a lot of Emacs packages. For this reason I would like to
propose to prefix them with 'emacs-' as we do with Python, ...

I'm not sure if there is a way to run some tests.  So, currently there
isn't a check phase.

To make those packages automatically available in Emacs without the
need for any code in the user '.emacs' file, I would suggest to
include in our Emacs package site initialization file some custom code
(to activate our ELPA emacs packages) such as the one in the attached
'guix-elpa.el' file.

If the feedback is positive, I will write documentation and some
tests; and send proper patches.

Regards,
Fede

[-- Attachment #2: elpa.scm --]
[-- Type: text/x-scheme, Size: 8286 bytes --]

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;;
;;; 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 <http://www.gnu.org/licenses/>.

(define-module (guix import elpa)
  #:use-module (ice-9 match)
  #:use-module (ice-9 rdelim)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-9)
  #:use-module (srfi srfi-9 gnu)
  #:use-module (srfi srfi-11)
  #:use-module ((guix download) #:select (download-to-store))
  #:use-module (guix import utils)
  #:use-module (guix store)
  #:use-module (guix hash)
  #:use-module (guix base32)
  #:use-module ((guix utils) #:select (call-with-temporary-output-file
                                       memoize))
  #:export (elpa->guix-package))

(define (elpa-dependencies->names deps)
  "Convert the list of dependencies from the ELPA format, to a list of string
names."
  (map (lambda (d) (symbol->string (first d))) deps))

(define (filter-dependencies names)
  "Remove the package names included with Emacs from the list of
NAMES (strings)."
  (let ((emacs-standard-libraries
         '("emacs" "cl-lib")))
    (filter (lambda (d) (not (member d emacs-standard-libraries)))
            names)))

(define (elpa-name->package-name name)
  "Given the NAME of an Emacs package, return the corresponding Guix name."
  (let ((package-name-prefix "emacs-"))
    (if (string-prefix? package-name-prefix name)
        (string-downcase name)
        (string-append package-name-prefix (string-downcase name)))))

(define* (elpa-url #:optional (repo "gnu"))
  "Retrun the URL of REPO."
  (let ((elpa-archives
         '(("gnu" . "http://elpa.gnu.org/packages")
           ("melpa-stable" . "http://stable.melpa.org/packages")
           ("melpa" . "http://melpa.org/packages"))))
    (assoc-ref elpa-archives repo)))

(define* (elpa-fetch-archive #:optional (repo "gnu"))
  "Retrive the archive with the list of packages available from REPO."
  (let ((url (string-append (elpa-url repo) "/archive-contents")))
    (fetch-and-call-with-input-file url read)))

;; Fetch URL, store the content in a temporary file and call PROC with that
;; file.
(define fetch-and-call-with-input-file
  (memoize
   (lambda* (url proc #:optional (err-msg "unavailable"))
     (call-with-temporary-output-file
      (lambda (temp port)
        (or (and (url-fetch url temp)
                 (call-with-input-file temp proc))
            err-msg))))))

(define* (elpa-package-info name #:optional (repo "gnu"))
  "Extract the information about the package NAME from the package archieve of
REPO."
  (let* ((archive (elpa-fetch-archive repo))
         (info (filter (lambda (p) (eq? (first p) (string->symbol name)))
                       (cdr archive))))
    (if (pair? info) (first info) #f)))

;; Object to store information about an ELPA package.
(define-record-type <elpa-package>
  (make-elpa-package name version inputs synopsis kind home-page description
                     source-url)
  elpa-package?
  (name elpa-package-name)
  (version elpa-package-version)
  (inputs elpa-package-inputs)
  (synopsis elpa-package-synopsis)
  (kind elpa-package-kind)
  (home-page elpa-package-home-page)
  (description elpa-package-description)
  (source-url elpa-package-source-url))

(set-record-type-printer! <elpa-package>
                          (lambda (package port)
                            (format port "#<elpa-package ~a-~a>"
                                      (elpa-package-name package)
                                      (elpa-package-version package))))

(define (elpa-version->string elpa-version)
  "Convert the package version as used in Emacs package files into a string."
  (if (pair? elpa-version)
      (let-values (((ms rest) (match elpa-version
                                ((ms . rest)
                                 (values ms rest)))))
        (fold (lambda (n s) (string-append s "." (number->string n)))
              (number->string ms) rest))
      #f))

(define (lookup-extra alist key)
  "Lookup KEY from the ALIST extra package information."
  (assq-ref alist key))

(define (package-home-page alist)
  "Extract the package home-page from ALIST."
  (or (lookup-extra alist ':url) "unspecified"))

(define (nil->empty alist)
  "If ALIST is the symbol 'nil return the empty list.  Otherwise, return ALIST."
  (if (eq? alist 'nil)
      '()
      alist))

(define (package-source-url kind name version repo)
  "Return the source URL of the package described the the strings NAME and
VERSION at REPO.  KIND is either the symbol 'single or 'tar."
  (case kind
    ((single) (full-url repo name ".el" version))
    ((tar) (full-url repo name ".tar" version))
    (else
     #f)))

(define* (full-url repo name suffix #:optional (version #f))
  "Return the full URL of the package NAME at REPO and the SUFFIX.  Maybe
include VERSION."
  (if version
      (string-append (elpa-url repo) "/" name "-" version suffix)
      (string-append (elpa-url repo) "/" name suffix)))

(define (fetch-package-description kind name repo)
  "Fetch the description of package NAME of type KIND from REPO."
  (let ((url (full-url repo name "-readme.txt")))
    (fetch-and-call-with-input-file url read-string)))

(define* (fetch-elpa-package name #:optional (repo "gnu"))
  "Fetch package NAME from REPO."
  (let ((pkg (elpa-package-info name repo)))
    (match pkg
      ((name version reqs synopsis kind . rest)
       (let* ((name (symbol->string name))
             (ver (elpa-version->string version))
             (url (package-source-url kind name ver repo)))
         (make-elpa-package name ver
                            (nil->empty reqs) synopsis kind
                            (package-home-page (first rest))
                            (fetch-package-description kind name repo)
                            url)))
      (_ #f))))

(define* (elpa-package->sexp pkg)
  "Return the `package' S-expression for the Emacs package PKG, a record of
type '<elpa-package>'."
  
  (define name (elpa-package-name pkg))
  
  (define version (elpa-package-version pkg))
  
  (define source-url (elpa-package-source-url pkg))
  
  (define dependencies
    (let* ((deps (elpa-package-inputs pkg))
           (names (filter-dependencies (elpa-dependencies->names deps))))
      (map (lambda (n)
             (let ((new-n (elpa-name->package-name n)))
               (list new-n (list 'unquote (string->symbol new-n)))))
           names)))
      
  (define (maybe-inputs input-type inputs)
    (match inputs
      (()
       '())
      ((inputs ...)
       (list (list input-type
                   (list 'quasiquote inputs))))))
  
  (let ((tarball (with-store store
                   (download-to-store store source-url))))
    `(package
       (name ,(elpa-name->package-name name))
       (version ,version)
       (source (origin
                 (method url-fetch)
                 (uri (string-append ,@(factorize-uri source-url version)))
                 (sha256
                  (base32
                   ,(if tarball
                        (bytevector->nix-base32-string (file-sha256 tarball))
                        "failed to download package")))))
       (build-system emacs-build-system)
       ,@(maybe-inputs 'inputs dependencies)
       (home-page ,(elpa-package-home-page pkg))
       (synopsis ,(elpa-package-synopsis pkg))
       (description ,(elpa-package-description pkg))
       (license license:gpl3+))))

(define* (elpa->guix-package name #:optional (repo "gnu"))
  "Fetch the package NAME from REPO and produce a Guix package S-expression."
  (let ((pkg (fetch-elpa-package name repo)))
    (and=> pkg elpa-package->sexp)))

;;; elpa.scm ends here

[-- Attachment #3: elpa.scm --]
[-- Type: text/x-scheme, Size: 3206 bytes --]

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;;
;;; 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 <http://www.gnu.org/licenses/>.

(define-module (guix scripts import elpa)
  #:use-module (guix ui)
  #:use-module (guix utils)
  #:use-module (guix import elpa)
  #:use-module (guix scripts import)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-11)
  #:use-module (srfi srfi-37)
  #:use-module (ice-9 match)
  #:use-module (ice-9 format)
  #:export (guix-import-elpa))

\f
;;;
;;; Command-line options.
;;;

(define %default-options
  '((repo . "gnu")))

(define (show-help)
  (display (_ "Usage: guix import elpa PACKAGE-NAME
Import the latest package named PACKAGE-NAME from an ELPA repository.\n"))
  (display (_ "
  -a ARCHIVE, --archive=ARCHIVE  specify the archive repository"))
  (display (_ "
  -h, --help                     display this help and exit"))
  (display (_ "
  -V, --version                  display version information and exit"))
  (newline)
  (show-bug-report-information))

(define %options
  ;; Specification of the command-line options.
  (cons* (option '(#\h "help") #f #f
                 (lambda args
                   (show-help)
                   (exit 0)))
         (option '(#\V "version") #f #f
                 (lambda args
                   (show-version-and-exit "guix import elpa")))
         (option '(#\a "archive") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'repo arg (alist-delete 'repo result))))
         %standard-import-options))

\f
;;;
;;; Entry point.
;;;

(define (guix-import-elpa . args)
  (define (parse-options)
    ;; Return the alist of option values.
    (args-fold* args %options
                (lambda (opt name arg result)
                  (leave (_ "~A: unrecognized option~%") name))
                (lambda (arg result)
                  (alist-cons 'argument arg result))
                %default-options))

  (let* ((opts (parse-options))
         (args (filter-map (match-lambda
                            (('argument . value)
                             value)
                            (_ #f))
                           (reverse opts))))
    (match args
      ((package-name)
       (let ((sexp (elpa->guix-package package-name (assoc-ref opts 'repo))))
         (unless sexp
           (leave (_ "failed to download package '~a'~%") package-name))
         sexp))
      (()
       (leave (_ "too few arguments~%")))
      ((many ...)
       (leave (_ "too many arguments~%"))))))

;;; elpa.scm ends here

[-- Attachment #4: emacs-build-system.scm --]
[-- Type: text/x-scheme, Size: 6740 bytes --]

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;;
;;; 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 <http://www.gnu.org/licenses/>.

(define-module (guix build emacs-build-system)
  #:use-module ((guix build gnu-build-system) #:prefix gnu:)
  #:use-module (guix build utils)
  #:use-module (guix build emacs-utils)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (ice-9 rdelim)
  #:use-module (ice-9 regex)
  #:use-module (ice-9 match)
  #:export (%standard-phases
            emacs-build))

;; Commentary:
;;
;; Builder-side code of the build procedure for ELPA Emacs packages.
;;
;; Code:

;; Path relative to 'out' where we install ELPA packages.  We avoid the
;; ".../elpa" path as Emacs expects to find the ELPA repository
;; 'archive-contents' file and the archive signature.
(define guix-elpa-packages-path "/share/emacs/site-lisp/guix.d")

(define* (build #:key outputs inputs #:allow-other-keys)
  "Compile .el files."
  (let* ((emacs (string-append (assoc-ref inputs "emacs") "/bin/emacs"))
         (out (assoc-ref outputs "out"))
         (name-ver (store-dir->elpa-name-version out))
         (el-dir (string-append out guix-elpa-packages-path "/" name-ver)))
    (setenv "SHELL" "sh")
    (with-directory-excursion el-dir
      (fold (lambda (f s)
              (and s (zero? (system* emacs "--batch" "-Q" "-L" el-dir
                                     "-f" "batch-byte-compile" f))))
            #t (find-files "." "\\.el$")))))

(define* (patch-el-files #:key outputs inputs #:allow-other-keys)
  "Substitute the right path for '/bin/sh' in .el files."
  (let* ((emacs (string-append (assoc-ref inputs "emacs") "/bin/emacs"))
         (out (assoc-ref outputs "out"))
         (name-ver (store-dir->elpa-name-version out))
         (el-dir (string-append out guix-elpa-packages-path "/" name-ver)))
    (setenv "LC_ALL" "en_US.UTF-8")
    (with-directory-excursion el-dir
      (substitute* (find-files "." ".*\\.el$") (("/bin/sh") (which "sh"))))
    #t))

(define* (copy #:key outputs #:allow-other-keys)
  "Copy the package content to the installation directory."
  (let* ((out (assoc-ref outputs "out"))
         (name-ver (store-dir->elpa-name-version out))
         (src-dir (getcwd))
         (tgt-dir (string-append out guix-elpa-packages-path "/" name-ver)))
    (copy-recursively src-dir tgt-dir)
    #t))

(define* (move-doc #:key outputs #:allow-other-keys)
  "Move info files from the ELPA package directory to the info directory."
  (let* ((out (assoc-ref outputs "out"))
         (name-ver (store-dir->name-version out))
         (elpa-name-ver (package-name-version->elpa-name-version name-ver))
         (doc-dir (string-append out "/share/info/" name-ver))
         (el-dir (string-append out guix-elpa-packages-path "/" elpa-name-ver))
         (info-files (find-files el-dir "\\.info$")))
    (unless (null? info-files)
      (mkdir-p doc-dir)
      (with-directory-excursion el-dir
        (when (file-exists? "dir") (delete-file "dir"))
        (for-each (lambda (f)
                    (copy-file f (string-append doc-dir "/" (basename f)))
                    (delete-file f))
                  info-files)))
    #t))

(define* (make-autoloads #:key outputs inputs #:allow-other-keys)
  "Generate the autoloads file."
  (let* ((out (assoc-ref outputs "out"))
         (emacs (string-append (assoc-ref inputs "emacs") "/bin/emacs"))
         (name-ver (store-dir->elpa-name-version out))
         (name (package-name->name+version name-ver))
         (lisp-dir (string-append out guix-elpa-packages-path "/" name-ver)))
    (parameterize ((%emacs emacs))
      (emacs-generate-autoloads name lisp-dir))
    #t))


(define (package-name-version->elpa-name-version name-ver)
  "Convert the Guix package NAME-VER to the corresponding ELPA name-version
format.  Essnetially drop the prefix used in Guix."
  (let ((name (store-dir->name-version name-ver)))
    (if (string-prefix? "emacs-" name-ver)
        (store-dir->name-version name-ver)
        name-ver)))

(define (store-dir->elpa-name-version store-dir)
  "Given a store directory STORE-DIR return the part of the basename after the
second hyphen.  This corresponds to 'name-version' as used in ELPA packages."
  ((compose package-name-version->elpa-name-version
            store-dir->name-version)
   store-dir))

(define (store-dir->name-version store-dir)
  "Given a store directory STORE-DIR return the part of the basename
after the first hyphen.  This corresponds to 'name-version' of the package."
  (let* ((base (basename store-dir)))
    (string-drop base
                 (+ 1 (string-index base #\-)))))

;; from (guix utils).  Should we put it in (guix build utils)?
(define (package-name->name+version name)
  "Given NAME, a package name like \"foo-0.9.1b\", return two values:
\"foo\" and \"0.9.1b\".  When the version part is unavailable, NAME and
#f are returned.  The first hyphen followed by a digit is considered to
introduce the version part."
  ;; See also `DrvName' in Nix.

  (define number?
    (cut char-set-contains? char-set:digit <>))

  (let loop ((chars   (string->list name))
             (prefix '()))
    (match chars
      (()
       (values name #f))
      ((#\- (? number? n) rest ...)
       (values (list->string (reverse prefix))
               (list->string (cons n rest))))
      ((head tail ...)
       (loop tail (cons head prefix))))))

(define %standard-phases
  (modify-phases gnu:%standard-phases
    (delete 'configure)
    (delete 'check)
    (delete 'install)
    (replace 'build build)
    (add-before 'build 'copy copy)
    (add-after 'copy 'make-autoloads make-autoloads)
    ;;(add-after 'make-autoloads 'patch-el-files patch-el-files)
    (add-after 'make-autoloads 'move-doc move-doc)))

(define* (emacs-build #:key inputs (phases %standard-phases)
                      #:allow-other-keys #:rest args)
  "Build the given Emacs package, applying all of PHASES in order."
  (apply gnu:gnu-build
         #:inputs inputs #:phases phases
         args))

;;; emacs-build-system.scm ends here

[-- Attachment #5: emacs.scm --]
[-- Type: text/x-scheme, Size: 5514 bytes --]

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;;
;;; 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 <http://www.gnu.org/licenses/>.

(define-module (guix build-system emacs)
  #:use-module (guix store)
  #:use-module (guix utils)
  #:use-module (guix packages)
  #:use-module (guix derivations)
  #:use-module (guix search-paths)
  #:use-module (guix build-system)
  #:use-module (guix build-system gnu)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-26)
  #:export (%emacs-build-system-modules
            emacs-build
            emacs-build-system))

;; Commentary:
;;
;; Standard build procedure for Emacs packages.  This is implemented as an
;; extension of 'gnu-build-system'.
;;
;; Code:

(define %emacs-build-system-modules
  ;; Build-side modules imported by default.
  `((guix build emacs-build-system)
    (guix build emacs-utils)
    ,@%gnu-build-system-modules))

(define (default-emacs)
  "Return the default Emacs package."
  ;; Lazily resolve the binding to avoid a circular dependency.
  (let ((emacs-mod (resolve-interface '(gnu packages emacs))))
    ;; we use 'emacs' instead of 'emacs-no-x' because the latter appears not
    ;; to be loading some macros and causes problems to some packages.  For
    ;; example, with the latter AUCTeX gives the error message:
    ;; "(invalid-function dbus-ignore-errors)".
    (module-ref emacs-mod 'emacs)))

(define* (lower name
                #:key source inputs native-inputs outputs system target
                (emacs (default-emacs))
                #:allow-other-keys
                #:rest arguments)
  "Return a bag for NAME."
  (define private-keywords
    '(#:target #:emacs #:inputs #:native-inputs))

  (and (not target)                               ;XXX: no cross-compilation
       (bag
         (name name)
         (system system)
         (host-inputs `(,@(if source
                              `(("source" ,source))
                              '())
                        ,@inputs

                        ;; Keep the standard inputs of 'gnu-build-system'.
                        ,@(standard-packages)))
         (build-inputs `(("emacs" ,emacs)
                         ,@native-inputs))
         (outputs outputs)
         (build emacs-build)
         (arguments (strip-keyword-arguments private-keywords arguments)))))

(define* (emacs-build store name inputs
                      #:key source
                      (tests? #t)
                      (test-target "test")
                      (configure-flags ''())
                      (phases '(@ (guix build emacs-build-system)
                                  %standard-phases))
                      (outputs '("out"))
                      (search-paths '())
                      (system (%current-system))
                      (guile #f)
                      (imported-modules %emacs-build-system-modules)
                      (modules '((guix build emacs-build-system)
                                 (guix build utils)
                                 (guix build emacs-utils))))
  "Build SOURCE using EMACS, and with INPUTS."
  (define builder
    `(begin
       (use-modules ,@modules)
       (emacs-build #:name ,name
                    #:source ,(match (assoc-ref inputs "source")
                                (((? derivation? source))
                                 (derivation->output-path source))
                                ((source)
                                 source)
                                (source
                                 source))
                    #:configure-flags ,configure-flags
                    #:system ,system
                    #:test-target ,test-target
                    #:tests? ,tests?
                    #:phases ,phases
                    #:outputs %outputs
                    #:search-paths ',(map search-path-specification->sexp
                                          search-paths)
                    #:inputs %build-inputs)))
  
  (define guile-for-build
    (match guile
      ((? package?)
       (package-derivation store guile system #:graft? #f))
      (#f                                         ; the default
       (let* ((distro (resolve-interface '(gnu packages commencement)))
              (guile  (module-ref distro 'guile-final)))
         (package-derivation store guile system #:graft? #f)))))

  (build-expression->derivation store name builder
                                #:inputs inputs
                                #:system system
                                #:modules imported-modules
                                #:outputs outputs
                                #:guile-for-build guile-for-build))

(define emacs-build-system
  (build-system
    (name 'emacs)
    (description "The build system for Emacs packages")
    (lower lower)))

;;; emacs.scm ends here

[-- Attachment #6: emacs-elpa.el --]
[-- Type: text/x-emacs-lisp, Size: 2336 bytes --]


(defun guix-package-desc-name (pkg-desc)
  "Return the name of the package. PKG-DESC is the unprocessed
list read from the package-description file."
  (nth 1 pkg-desc))

(defun guix-package-description-file (dir)
  "Return the name of the description file of the package in
DIR. (From Emacs 'package--description-file' in 'startup.el')."
  (concat (let ((subdir (file-name-nondirectory
                         (directory-file-name dir))))
            (if (string-match "\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)" subdir)
                (match-string 1 subdir) subdir))
          "-pkg.el"))

(defun guix-package-load-descriptor (pkg-dir)
  "Return the uninterpreted content of the description file in
directory PKG-DIR. (Adapted from Emacs 'package-load-descriptor'
in 'package.el'.)"
  (let ((pkg-file (expand-file-name (guix-package-description-file pkg-dir)
                                    pkg-dir)))
    (when (file-exists-p pkg-file)
      (with-temp-buffer
        (insert-file-contents pkg-file)
        (goto-char (point-min))
        (read (current-buffer))))))

(defun guix-package-load-all (dir)
  "Activate all packages below DIR. (Adapted from Emacs
'package-activate-1' in 'package.el'.)"
  (when (file-directory-p dir)
    (dolist (subdir (directory-files dir))
      (let ((pkg-dir (expand-file-name subdir dir)))
        (when (file-directory-p pkg-dir)
          (let* ((pkg-desc (guix-package-load-descriptor pkg-dir))
                 (name (guix-package-desc-name pkg-desc))
                 (pkg-file (expand-file-name
                            (format "%s-autoloads.el" name) pkg-dir)))
            (when (file-exists-p pkg-file)
              ;; For some packages to be properly loaded (e.g.,
              ;; AUCTeX), they must be on the load-path.  However,
              ;; some packages add themselves to the load-path.  Hence
              ;; the check to avoid duplications.
              (push pkg-dir load-path)
              (let ((old-lp load-path))
                (with-demoted-errors (load pkg-file nil t))
                (unless (eq old-lp load-path)
                  (setq load-path old-lp))))))))))

(let* ((dir (concat (getenv "HOME") ".guix-profile/share/emacs/site-lisp/guix.d")))
  (when (file-exists-p dir)
    (guix-package-load-all dir)))