gnu/packages/aux-files/emacs/guix-emacs.el

   1 ;;; guix-emacs.el --- Emacs packages installed with Guix
   2
   3 ;; Copyright © 2014, 2015, 2016, 2017 Alex Kost <alezost@gmail.com>
   4
   5 ;; This file is part of GNU Guix.
   6
   7 ;; GNU Guix is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation, either version 3 of the License, or
  10 ;; (at your option) any later version.
  11
  12 ;; GNU Guix is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 ;;; Commentary:
  21
  22 ;; This file provides auxiliary code to autoload Emacs packages
  23 ;; installed with Guix.
  24
  25 ;;; Code:
  26
  27 (require 'cl-lib)
  28
  29 (defvar guix-user-profile (expand-file-name "~/.guix-profile"))
  30
  31 (defvar guix-emacs-autoloads nil
  32   "List of the last loaded Emacs autoloads.")
  33
  34 (defvar guix-emacs-autoloads-regexp
  35   (rx (group (* any) "-autoloads")
  36       ".el" (zero-or-one "c") string-end)
  37   "Regexp to match Emacs 'autoloads' file.")
  38
  39 (defun guix-emacs-directory (&optional profile)
  40   "Return directory with Emacs packages installed in PROFILE.
  41 If PROFILE is nil, use `guix-user-profile'."
  42   (expand-file-name "share/emacs/site-lisp"
  43                     (or profile guix-user-profile)))
  44
  45 (defun guix-emacs-find-autoloads (directory)
  46   "Return a list of Emacs 'autoloads' files in DIRECTORY.
  47 The files in the list do not have extensions (.el, .elc)."
  48   (cl-remove-duplicates
  49    (delq nil
  50         (mapcar (lambda (file)
  51                   (when (string-match guix-emacs-autoloads-regexp file)
  52                     (match-string 1 file)))
  53                 (directory-files directory 'full-name nil 'no-sort)))
  54    :test #'string=))
  55
  56 (defun guix-emacs-subdirs (directory)
  57   "Return list of DIRECTORY subdirectories."
  58   (cl-remove-if (lambda (file)
  59                   (or (string-match-p (rx "/." string-end) file)
  60                       (string-match-p (rx "/.." string-end) file)
  61                       (not (file-directory-p file))))
  62                 (directory-files directory 'full-name nil 'no-sort)))
  63
  64 (defun guix-emacs-directories (&optional profile)
  65   "Return the list of directories under PROFILE that contain Emacs packages.
  66 This includes both `share/emacs/site-lisp/guix.d/PACKAGE'
  67 sub-directories and `share/emacs/site-lisp' itself.
  68
  69 If PROFILE is nil, use `guix-user-profile'.
  70 Return nil, if Emacs packages are not installed in PROFILE."
  71   (let ((root-dir (guix-emacs-directory (or profile guix-user-profile))))
  72     (when (file-directory-p root-dir)
  73       (let* ((pkgs-dir  (expand-file-name "guix.d" root-dir))
  74              (pkgs-dirs (when (file-directory-p pkgs-dir)
  75                           (guix-emacs-subdirs pkgs-dir))))
  76         (cons root-dir pkgs-dirs)))))
  77
  78 ;;;###autoload
  79 (defun guix-emacs-autoload-packages (&rest profiles)
  80   "Autoload Emacs packages installed in PROFILES.
  81 If PROFILES are not specified, use a default user and system
  82 profiles.
  83
  84 'Autoload' means add directories with Emacs packages to
  85 `load-path' and load 'autoloads' files matching
  86 `guix-emacs-autoloads-regexp'."
  87   (interactive (list (if (fboundp 'guix-read-package-profile)
  88                          (funcall 'guix-read-package-profile)
  89                        guix-user-profile)))
  90   (let ((profiles (or profiles
  91                       (list "/run/current-system/profile"
  92                             guix-user-profile))))
  93     (dolist (profile profiles)
  94       (let ((dirs (guix-emacs-directories profile)))
  95         (when dirs
  96           (let* ((autoloads     (cl-mapcan #'guix-emacs-find-autoloads
  97                                            dirs))
  98                  (new-autoloads (cl-nset-difference autoloads
  99                                                     guix-emacs-autoloads
 100                                                     :test #'string=)))
 101             (dolist (dir dirs)
 102               (cl-pushnew (directory-file-name dir)
 103                           load-path
 104                           :test #'string=))
 105             (dolist (file new-autoloads)
 106               (load file 'noerror))
 107             (setq guix-emacs-autoloads
 108                   (append new-autoloads guix-emacs-autoloads))))))))
 109
 110 (provide 'guix-emacs)
 111
 112 ;;; guix-emacs.el ends here