;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 Federico Beffa ;;; ;;; 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 . (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