From 68228d80dd575f0042d71b4563d82a8fef577a47 Mon Sep 17 00:00:00 2001
From: Leo Prikler <leo.prikler@student.tugraz.at>
Date: Sat, 17 Apr 2021 19:06:16 +0200
Subject: [PATCH] profiles: Add hook for Emacs subdirs.

* guix/profiles.scm (emacs-subdirs): New variable.
(%default-profile-hooks): Add it here.
* guix/status.scm (hook-message): Add a message for emacs-subdirs.
---
 guix/profiles.scm | 41 +++++++++++++++++++++++++++++++++++++++++
 guix/status.scm   |  2 ++
 2 files changed, 43 insertions(+)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 67d90532c1..26fe266a61 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -1115,6 +1115,46 @@ MANIFEST.  Single-file bundles are required by programs such as Git and Lynx."
                     `((type . profile-hook)
                       (hook . ca-certificate-bundle))))
 
+(define (emacs-subdirs manifest)
+  (define build
+    (with-imported-modules (source-module-closure
+                            '((guix build profiles)
+                              (guix build utils)))
+      #~(begin
+          (use-modules (guix build utils)
+                       (guix build profiles)
+                       (ice-9 ftw) ; scandir
+                       (srfi srfi-1) ; append-map
+                       (srfi srfi-26))
+
+          (let ((destdir (string-append #$output "/share/emacs/site-lisp"))
+                (subdirs
+                 (append-map
+                  (lambda (dir)
+                    (filter
+                     file-is-directory?
+                     (map (cute string-append dir "/" <>)
+                          (scandir dir (negate (cute member <> '("." "..")))))))
+                  (filter file-exists?
+                          (map (cute string-append <> "/share/emacs/site-lisp")
+                               '#$(manifest-inputs manifest))))))
+            (mkdir-p destdir)
+            (with-directory-excursion destdir
+              (call-with-output-file "subdirs.el"
+                (lambda (port)
+                  (write
+                   `(normal-top-level-add-to-load-path
+                     (list ,@subdirs))
+                   port)
+                  (newline port)
+                  #t)))))))
+  (gexp->derivation "emacs-subdirs" build
+                    #:local-build? #t
+                    #:substitutable? #f
+                    #:properties
+                    `((type . profile-hook)
+                      (hook . emacs-subdirs))))
+
 (define (glib-schemas manifest)
   "Return a derivation that unions all schemas from manifest entries and
 creates the Glib 'gschemas.compiled' file."
@@ -1672,6 +1712,7 @@ MANIFEST."
         fonts-dir-file
         ghc-package-cache-file
         ca-certificate-bundle
+        emacs-subdirs
         glib-schemas
         gtk-icon-themes
         gtk-im-modules
diff --git a/guix/status.scm b/guix/status.scm
index 5820509b4c..97e4ab6284 100644
--- a/guix/status.scm
+++ b/guix/status.scm
@@ -379,6 +379,8 @@ the current build phase."
      (G_ "building GHC package cache..."))
     ('ca-certificate-bundle
      (G_ "building CA certificate bundle..."))
+    ('emacs-subdirs
+     (G_ "listing Emacs subdirs..."))
     ('glib-schemas
      (G_ "generating GLib schema cache..."))
     ('gtk-icon-themes