guix/build/emacs-build-system.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (guix build emacs-build-system)
  20   #:use-module ((guix build gnu-build-system) #:prefix gnu:)
  21   #:use-module (guix build utils)
  22   #:use-module (guix build emacs-utils)
  23   #:use-module (srfi srfi-1)
  24   #:use-module (srfi srfi-26)
  25   #:use-module (ice-9 rdelim)
  26   #:use-module (ice-9 regex)
  27   #:use-module (ice-9 match)
  28   #:export (%standard-phases
  29             emacs-build))
  30
  31 ;; Commentary:
  32 ;;
  33 ;; Builder-side code of the build procedure for ELPA Emacs packages.
  34 ;;
  35 ;; Code:
  36
  37 ;; Directory suffix where we install ELPA packages.  We avoid ".../elpa" as
  38 ;; Emacs expects to find the ELPA repository 'archive-contents' file and the
  39 ;; archive signature.
  40 (define %install-suffix "/share/emacs/site-lisp/guix.d")
  41
  42 (define* (build #:key outputs inputs #:allow-other-keys)
  43   "Compile .el files."
  44   (let* ((emacs (string-append (assoc-ref inputs "emacs") "/bin/emacs"))
  45          (out (assoc-ref outputs "out"))
  46          (elpa-name-ver (store-directory->elpa-name-version out))
  47          (el-dir (string-append out %install-suffix "/" elpa-name-ver))
  48          (deps-dirs (emacs-inputs-directories inputs)))
  49     (setenv "SHELL" "sh")
  50     (parameterize ((%emacs emacs))
  51       (emacs-byte-compile-directory el-dir
  52                                     (emacs-inputs-el-directories deps-dirs)))))
  53
  54 (define* (patch-el-files #:key outputs #:allow-other-keys)
  55   "Substitute the absolute \"/bin/\" directory with the right location in the
  56 store in '.el' files."
  57   (let* ((out (assoc-ref outputs "out"))
  58          (elpa-name-ver (store-directory->elpa-name-version out))
  59          (el-dir (string-append out %install-suffix "/" elpa-name-ver))
  60          (substitute-cmd (lambda ()
  61                            (substitute* (find-files "." "\\.el$")
  62                              (("\"/bin/(.*)\"" _ cmd)
  63                               (string-append "\"" (which cmd) "\""))))))
  64     (with-directory-excursion el-dir
  65       ;; Some old '.el' files (e.g., tex-buf.el in AUCTeX) are still encoded
  66       ;; with the "ISO-8859-1" locale.
  67       (unless (false-if-exception (substitute-cmd))
  68         (with-fluids ((%default-port-encoding "ISO-8859-1"))
  69           (substitute-cmd))))
  70     #t))
  71
  72 (define* (install #:key outputs #:allow-other-keys)
  73   "Install the package contents."
  74   (let* ((out (assoc-ref outputs "out"))
  75          (elpa-name-ver (store-directory->elpa-name-version out))
  76          (src-dir (getcwd))
  77          (tgt-dir (string-append out %install-suffix "/" elpa-name-ver)))
  78     (copy-recursively src-dir tgt-dir)
  79     #t))
  80
  81 (define* (move-doc #:key outputs #:allow-other-keys)
  82   "Move info files from the ELPA package directory to the info directory."
  83   (let* ((out (assoc-ref outputs "out"))
  84          (elpa-name-ver (store-directory->elpa-name-version out))
  85          (el-dir (string-append out %install-suffix "/" elpa-name-ver))
  86          (name-ver (store-directory->name-version out))
  87          (info-dir (string-append out "/share/info/" name-ver))
  88          (info-files (find-files el-dir "\\.info$")))
  89     (unless (null? info-files)
  90       (mkdir-p info-dir)
  91       (with-directory-excursion el-dir
  92         (when (file-exists? "dir") (delete-file "dir"))
  93         (for-each (lambda (f)
  94                     (copy-file f (string-append info-dir "/" (basename f)))
  95                     (delete-file f))
  96                   info-files)))
  97     #t))
  98
  99 (define* (make-autoloads #:key outputs inputs #:allow-other-keys)
 100   "Generate the autoloads file."
 101   (let* ((emacs (string-append (assoc-ref inputs "emacs") "/bin/emacs"))
 102          (out (assoc-ref outputs "out"))
 103          (elpa-name-ver (store-directory->elpa-name-version out))
 104          (elpa-name (package-name->name+version elpa-name-ver))
 105          (el-dir (string-append out %install-suffix "/" elpa-name-ver)))
 106     (parameterize ((%emacs emacs))
 107       (emacs-generate-autoloads elpa-name el-dir))
 108     #t))
 109
 110 (define (emacs-package? name)
 111   "Check if NAME correspond to the name of an Emacs package."
 112   (string-prefix? "emacs-" name))
 113
 114 (define (emacs-inputs inputs)
 115   "Retrieve the list of Emacs packages from INPUTS."
 116   (filter (match-lambda
 117             ((label directory)
 118              (emacs-package? ((compose package-name->name+version
 119                                        store-directory->name-version)
 120                               directory)))
 121             (_ #f))
 122           inputs))
 123
 124 (define (emacs-inputs-directories inputs)
 125   "Extract the list of Emacs package directories from INPUTS."
 126   (let ((inputs (emacs-inputs inputs)))
 127     (match inputs
 128       (((names . directories) ...) directories))))
 129
 130 (define (emacs-inputs-el-directories dirs)
 131   "Build the list of Emacs Lisp directories from the Emacs package directory
 132 DIRS."
 133   (map (lambda (d)
 134          (string-append d %install-suffix "/"
 135                         (store-directory->elpa-name-version d)))
 136        dirs))
 137
 138 (define (package-name-version->elpa-name-version name-ver)
 139   "Convert the Guix package NAME-VER to the corresponding ELPA name-version
 140 format.  Essnetially drop the prefix used in Guix."
 141   (let ((name (store-directory->name-version name-ver)))
 142     (if (emacs-package? name-ver)
 143         (store-directory->name-version name-ver)
 144         name-ver)))
 145
 146 (define (store-directory->elpa-name-version store-dir)
 147   "Given a store directory STORE-DIR return the part of the basename after the
 148 second hyphen.  This corresponds to 'name-version' as used in ELPA packages."
 149   ((compose package-name-version->elpa-name-version
 150             store-directory->name-version)
 151    store-dir))
 152
 153 (define (store-directory->name-version store-dir)
 154   "Given a store directory STORE-DIR return the part of the basename
 155 after the first hyphen.  This corresponds to 'name-version' of the package."
 156   (let* ((base (basename store-dir)))
 157     (string-drop base
 158                  (+ 1 (string-index base #\-)))))
 159
 160 ;; from (guix utils).  Should we put it in (guix build utils)?
 161 (define (package-name->name+version name)
 162   "Given NAME, a package name like \"foo-0.9.1b\", return two values:
 163 \"foo\" and \"0.9.1b\".  When the version part is unavailable, NAME and
 164 #f are returned.  The first hyphen followed by a digit is considered to
 165 introduce the version part."
 166   ;; See also `DrvName' in Nix.
 167
 168   (define number?
 169     (cut char-set-contains? char-set:digit <>))
 170
 171   (let loop ((chars   (string->list name))
 172              (prefix '()))
 173     (match chars
 174       (()
 175        (values name #f))
 176       ((#\- (? number? n) rest ...)
 177        (values (list->string (reverse prefix))
 178                (list->string (cons n rest))))
 179       ((head tail ...)
 180        (loop tail (cons head prefix))))))
 181
 182 (define %standard-phases
 183   (modify-phases gnu:%standard-phases
 184     (delete 'configure)
 185     (delete 'check)
 186     (delete 'install)
 187     (replace 'build build)
 188     (add-before 'build 'install install)
 189     (add-after 'install 'make-autoloads make-autoloads)
 190     (add-after 'make-autoloads 'patch-el-files patch-el-files)
 191     (add-after 'make-autoloads 'move-doc move-doc)))
 192
 193 (define* (emacs-build #:key inputs (phases %standard-phases)
 194                       #:allow-other-keys #:rest args)
 195   "Build the given Emacs package, applying all of PHASES in order."
 196   (apply gnu:gnu-build
 197          #:inputs inputs #:phases phases
 198          args))
 199
 200 ;;; emacs-build-system.scm ends here