guix/build/emacs-build-system.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
   3 ;;; Copyright © 2016 David Thompson <davet@gnu.org>
   4 ;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
   5 ;;; Copyright © 2018, 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
   6 ;;;
   7 ;;; This file is part of GNU Guix.
   8 ;;;
   9 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  10 ;;; under the terms of the GNU General Public License as published by
  11 ;;; the Free Software Foundation; either version 3 of the License, or (at
  12 ;;; your option) any later version.
  13 ;;;
  14 ;;; GNU Guix is distributed in the hope that it will be useful, but
  15 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;;; GNU General Public License for more details.
  18 ;;;
  19 ;;; You should have received a copy of the GNU General Public License
  20 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 (define-module (guix build emacs-build-system)
  23   #:use-module ((guix build gnu-build-system) #:prefix gnu:)
  24   #:use-module ((guix build utils) #:hide (delete))
  25   #:use-module (guix build emacs-utils)
  26   #:use-module (srfi srfi-1)
  27   #:use-module (srfi srfi-11)
  28   #:use-module (srfi srfi-26)
  29   #:use-module (ice-9 rdelim)
  30   #:use-module (ice-9 regex)
  31   #:use-module (ice-9 match)
  32   #:export (%standard-phases
  33             %default-include
  34             %default-exclude
  35             emacs-build))
  36
  37 ;; Commentary:
  38 ;;
  39 ;; Builder-side code of the build procedure for ELPA Emacs packages.
  40 ;;
  41 ;; Code:
  42
  43 ;;; All the packages are installed directly under site-lisp, which means that
  44 ;;; having that directory in the EMACSLOADPATH is enough to have them found by
  45 ;;; Emacs.
  46 (define %install-dir "/share/emacs/site-lisp")
  47
  48 ;; These are the default inclusion/exclusion regexps for the install phase.
  49 (define %default-include '("^[^/]*\\.el$" "^[^/]*\\.info$" "^doc/.*\\.info$"))
  50 (define %default-exclude '("^\\.dir-locals\\.el$" "-pkg\\.el$"
  51                            "^[^/]*tests?\\.el$"))
  52
  53 (define gnu:unpack (assoc-ref gnu:%standard-phases 'unpack))
  54
  55 (define (store-file->elisp-source-file file)
  56   "Convert FILE, a store file name for an Emacs Lisp source file, into a file
  57 name that has been stripped of the hash and version number."
  58   (let ((suffix ".el"))
  59     (let-values (((name version)
  60                   (package-name->name+version
  61                    (basename
  62                     (strip-store-file-name file) suffix))))
  63       (string-append name suffix))))
  64
  65 (define* (unpack #:key source #:allow-other-keys)
  66   "Unpack SOURCE into the build directory.  SOURCE may be a compressed
  67 archive, a directory, or an Emacs Lisp file."
  68   (if (string-suffix? ".el" source)
  69       (begin
  70         (mkdir "source")
  71         (chdir "source")
  72         (copy-file source (store-file->elisp-source-file source))
  73         #t)
  74       (gnu:unpack #:source source)))
  75
  76 (define* (add-source-to-load-path #:key dummy #:allow-other-keys)
  77   "Augment the EMACSLOADPATH environment variable with the source directory."
  78   (let* ((source-directory (getcwd))
  79          (emacs-load-path (string-split (getenv "EMACSLOADPATH") #\:))
  80          ;; XXX: Make sure the Emacs core libraries appear at the end of
  81          ;; EMACSLOADPATH, to avoid shadowing any other libraries depended
  82          ;; upon.
  83          (emacs-load-path-non-core (filter (cut string-contains <>
  84                                                 "/share/emacs/site-lisp")
  85                                            emacs-load-path))
  86          (emacs-load-path-value (string-append
  87                                  (string-join (cons source-directory
  88                                                     emacs-load-path-non-core)
  89                                               ":")
  90                                  ":")))
  91     (setenv "EMACSLOADPATH" emacs-load-path-value)
  92     (format #t "source directory ~s prepended to the `EMACSLOADPATH' \
  93 environment variable\n" source-directory)))
  94
  95 (define* (build #:key outputs inputs #:allow-other-keys)
  96   "Compile .el files."
  97   (let* ((emacs (string-append (assoc-ref inputs "emacs") "/bin/emacs"))
  98          (out (assoc-ref outputs "out"))
  99          (site-lisp (string-append out %install-dir)))
 100     (setenv "SHELL" "sh")
 101     (parameterize ((%emacs emacs))
 102       (emacs-byte-compile-directory site-lisp))))
 103
 104 (define* (patch-el-files #:key outputs #:allow-other-keys)
 105   "Substitute the absolute \"/bin/\" directory with the right location in the
 106 store in '.el' files."
 107
 108   (define (file-contains-nul-char? file)
 109     (call-with-input-file file
 110       (lambda (in)
 111         (let loop ((line (read-line in 'concat)))
 112           (cond
 113            ((eof-object? line) #f)
 114            ((string-index line #\nul) #t)
 115            (else (loop (read-line in 'concat))))))
 116       #:binary #t))
 117
 118   (let* ((out (assoc-ref outputs "out"))
 119          (site-lisp (string-append out %install-dir))
 120          ;; (ice-9 regex) uses libc's regexp routines, which cannot deal with
 121          ;; strings containing NULs.  Filter out such files.  TODO: Remove
 122          ;; this workaround when <https://bugs.gnu.org/30116> is fixed.
 123          (el-files (remove file-contains-nul-char?
 124                            (find-files (getcwd) "\\.el$"))))
 125     (define (substitute-program-names)
 126       (substitute* el-files
 127         (("\"/bin/([^.]\\S*)\"" _ cmd-name)
 128          (let ((cmd (which cmd-name)))
 129            (unless cmd
 130              (error "patch-el-files: unable to locate " cmd-name))
 131            (string-append "\"" cmd "\"")))))
 132
 133     (with-directory-excursion site-lisp
 134       ;; Some old '.el' files (e.g., tex-buf.el in AUCTeX) are still
 135       ;; ISO-8859-1-encoded.
 136       (unless (false-if-exception (substitute-program-names))
 137         (with-fluids ((%default-port-encoding "ISO-8859-1"))
 138           (substitute-program-names))))
 139     #t))
 140
 141 (define* (check #:key tests? (test-command '("make" "check"))
 142                 (parallel-tests? #t) #:allow-other-keys)
 143   "Run the tests by invoking TEST-COMMAND.
 144
 145 When TEST-COMMAND uses make and PARALLEL-TESTS is #t, the tests are run in
 146 parallel. PARALLEL-TESTS? is ignored when using a non-make TEST-COMMAND."
 147   (match-let (((test-program . args) test-command))
 148     (let ((using-make? (string=? test-program "make")))
 149       (if tests?
 150           (apply invoke test-program
 151                  `(,@args
 152                    ,@(if (and using-make? parallel-tests?)
 153                          `("-j" ,(number->string (parallel-job-count)))
 154                          '())))
 155           (begin
 156             (format #t "test suite not run~%")
 157             #t)))))
 158
 159 (define* (install #:key outputs
 160                   (include %default-include)
 161                   (exclude %default-exclude)
 162                   #:allow-other-keys)
 163   "Install the package contents."
 164
 165   (define source (getcwd))
 166
 167   (define* (install-file? file stat #:key verbose?)
 168     (let* ((stripped-file (string-trim
 169                            (string-drop file (string-length source)) #\/)))
 170       (define (match-stripped-file action regex)
 171         (let ((result (string-match regex stripped-file)))
 172           (when (and result verbose?)
 173                 (format #t "info: ~A ~A as it matches \"~A\"\n"
 174                         stripped-file action regex))
 175           result))
 176
 177       (when verbose?
 178             (format #t "info: considering installing ~A\n" stripped-file))
 179
 180       (and (any (cut match-stripped-file "included" <>) include)
 181            (not (any (cut match-stripped-file "excluded" <>) exclude)))))
 182
 183   (let* ((out (assoc-ref outputs "out"))
 184          (site-lisp (string-append out %install-dir))
 185          (files-to-install (find-files source install-file?)))
 186     (cond
 187      ((not (null? files-to-install))
 188       (for-each
 189        (lambda (file)
 190          (let* ((stripped-file (string-drop file (string-length source)))
 191                 (target-file (string-append site-lisp stripped-file)))
 192            (format #t "`~a' -> `~a'~%" file target-file)
 193            (install-file file (dirname target-file))))
 194        files-to-install)
 195       #t)
 196      (else
 197       (format #t "error: No files found to install.\n")
 198       (find-files source (lambda (file stat)
 199                            (install-file? file stat #:verbose? #t)))
 200       #f))))
 201
 202 (define* (move-doc #:key outputs #:allow-other-keys)
 203   "Move info files from the ELPA package directory to the info directory."
 204   (let* ((out (assoc-ref outputs "out"))
 205          (site-lisp (string-append out %install-dir))
 206          (info-dir (string-append out "/share/info/"))
 207          (info-files (find-files site-lisp "\\.info$")))
 208     (unless (null? info-files)
 209       (mkdir-p info-dir)
 210       (with-directory-excursion site-lisp
 211         (when (file-exists? "dir") (delete-file "dir"))
 212         (for-each (lambda (f)
 213                     (copy-file f (string-append info-dir "/" (basename f)))
 214                     (delete-file f))
 215                   info-files)))
 216     #t))
 217
 218 (define* (make-autoloads #:key outputs inputs #:allow-other-keys)
 219   "Generate the autoloads file."
 220   (let* ((emacs (string-append (assoc-ref inputs "emacs") "/bin/emacs"))
 221          (out (assoc-ref outputs "out"))
 222          (site-lisp (string-append out %install-dir))
 223          (elpa-name-ver (store-directory->elpa-name-version out))
 224          (elpa-name (package-name->name+version elpa-name-ver)))
 225     (parameterize ((%emacs emacs))
 226       (emacs-generate-autoloads elpa-name site-lisp))))
 227
 228 (define* (enable-autoloads-compilation #:key outputs #:allow-other-keys)
 229   "Remove the NO-BYTE-COMPILATION local variable embedded in the generated
 230 autoload files."
 231   (let* ((out (assoc-ref outputs "out"))
 232          (autoloads (find-files out "-autoloads.el$")))
 233     (substitute* autoloads
 234       ((";; no-byte-compile.*") ""))
 235     #t))
 236
 237 (define* (validate-compiled-autoloads #:key outputs #:allow-other-keys)
 238   "Verify whether the byte compiled autoloads load fine."
 239   (let* ((out (assoc-ref outputs "out"))
 240          (autoloads (find-files out "-autoloads.elc$")))
 241     (emacs-batch-eval (format #f "(mapc #'load '~s)" autoloads))))
 242
 243 (define (emacs-package? name)
 244   "Check if NAME correspond to the name of an Emacs package."
 245   (string-prefix? "emacs-" name))
 246
 247 (define (package-name-version->elpa-name-version name-ver)
 248   "Convert the Guix package NAME-VER to the corresponding ELPA name-version
 249 format.  Essentially drop the prefix used in Guix."
 250   (if (emacs-package? name-ver)  ; checks for "emacs-" prefix
 251       (string-drop name-ver (string-length "emacs-"))
 252       name-ver))
 253
 254 (define (store-directory->elpa-name-version store-dir)
 255   "Given a store directory STORE-DIR return the part of the basename after the
 256 second hyphen.  This corresponds to 'name-version' as used in ELPA packages."
 257   ((compose package-name-version->elpa-name-version
 258             strip-store-file-name)
 259    store-dir))
 260
 261 (define %standard-phases
 262   (modify-phases gnu:%standard-phases
 263     (replace 'unpack unpack)
 264     (add-after 'unpack 'add-source-to-load-path add-source-to-load-path)
 265     (delete 'bootstrap)
 266     (delete 'configure)
 267     (delete 'build)
 268     (replace 'check check)
 269     (replace 'install install)
 270     (add-after 'install 'make-autoloads make-autoloads)
 271     (add-after 'make-autoloads 'enable-autoloads-compilation
 272       enable-autoloads-compilation)
 273     (add-after 'enable-autoloads-compilation 'patch-el-files patch-el-files)
 274     ;; The .el files are byte compiled directly in the store.
 275     (add-after 'patch-el-files 'build build)
 276     (add-after 'build 'validate-compiled-autoloads validate-compiled-autoloads)
 277     (add-after 'validate-compiled-autoloads 'move-doc move-doc)))
 278
 279 (define* (emacs-build #:key inputs (phases %standard-phases)
 280                       #:allow-other-keys #:rest args)
 281   "Build the given Emacs package, applying all of PHASES in order."
 282   (apply gnu:gnu-build
 283          #:inputs inputs #:phases phases
 284          args))
 285
 286 ;;; emacs-build-system.scm ends here