4037eb43428f4beb335e30c234c71949529d8ef0 — ( 1 year, 1 month ago c429810
feat(home): rewrite HOME-EMACS-SERVICE-TYPE

This commit completely rewrites the HOME-EMACS-SERVICE-TYPE, adding numerous
features.  It should now be upstream-quality :)

- Environment variables for the Emacs daemon are now set by building a profile
  out of the Emacs packages provided.
- Launching multiple differently-named Emacs servers is now supported.
- You can now specify the Emacs to run as the daemon and the Emacs for compiling
  packages as separate fields.
- Emacs is now launched only when a connection is received on its socket, thanks
1 files changed, 139 insertions(+), 95 deletions(-)

M guixrus/home/services/emacs.scm
M guixrus/home/services/emacs.scm => guixrus/home/services/emacs.scm +139 -95
@@ 1,5 1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2022 ( <paren@disroot.org>
;;; Copyright © 2022, 2023 ( <paren@disroot.org>
;;; This file is not part of GNU Guix.

@@ 19,130 19,174 @@
(define-module (guixrus home services emacs)
  #:use-module (gnu home services)
  #:use-module (gnu home services shepherd)
  #:autoload   (gnu packages emacs) (emacs-minimal
  #:autoload   (gnu packages emacs) (emacs emacs-minimal)
  #:autoload   (gnu packages gnupg) (guile-gcrypt)
  #:use-module (gnu services configuration)
  #:use-module (guix derivations)
  #:use-module (guix gexp)
  #:use-module (guix packages)
  #:use-module (guix modules)
  #:use-module (guix monads)
  #:use-module (guix profiles)
  #:use-module (guix records)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)

  #:use-module (guix search-paths)
  #:use-module (guix store)
  #:use-module (ice-9 match)
  #:export (home-emacs-configuration

(define list-of-string?
  (list-of string?))

(define list-of-file-likes?
  (list-of file-like?))

(define file-like-or-#f?
    ((or #f
         (? file-like?)) #t)
    (_ #f)))

(define-configuration/no-serialization home-emacs-configuration
   (list-of-string (list "server"))
   "List of strings which name Emacs servers to run.")
   (file-like emacs)
   "The package providing @file{/bin/emacs}.")
   (list-of-file-likes '())
   "Packages to add to the Emacs plugin load path.")
   "Packages to add to the Emacs load path.")
   (boolean #f)
   "Whether to compile the @code{packages} using the Emacs package
provided as the value of the @code{emacs} field, which will enable
native compilation if the @code{emacs} package supports it.")
   "Whether to enable native-compilation of Emacs packages by building them with
@code{emacs} rather than @code{emacs-minimal}.  Has no effect if
COMPILATION-EMACS is not set to #F.")
   (file-like-or-#f #f)
   "The Emacs package to use to compile Emacs packages.  If #F, default to
   (file-like (plain-file "init.el" ""))
   "File-like to use as the initialisation Lisp file.")
   "File-like object to use as the Emacs initialisation script.")
   (file-like (plain-file "early-init.el" ""))
   "File-like to use as the pre-initialisation Lisp file.")
   "File-like object to use as the Emacs early-initialisation script.")
   (boolean #f)
   "Whether to enable debugging."))
   "Whether to enable debug output from Emacs."))

(define (home-emacs-profile-packages config)
  (list (home-emacs-configuration-emacs config)))
(define (emacs-for-compile config)
  (match-record config <home-emacs-configuration> (native-compile?
     (compilation-emacs compilation-emacs)
     (native-compile? emacs)
     (else emacs-minimal))))

(define (home-emacs-transformed-packages config)
  (map (if (home-emacs-configuration-native-compile? config)
              . ,(home-emacs-configuration-emacs config))))
       (let ((packages (home-emacs-configuration-packages config)))
          (cons packages
                (map (compose (cute map second <>)
(define (transformed-emacs-packages config)
  (match-record config <home-emacs-configuration> (packages)
    (map (package-input-rewriting
          `((,emacs-minimal . ,(emacs-for-compile config))))

(define (home-emacs-shepherd-services config)
  (list (shepherd-service
         (provision '(emacs))
         (documentation "Start the Emacs daemon.")
         (modules '((ice-9 ftw)
                    (srfi srfi-1)
                    (srfi srfi-26)))
             (list #$(file-append
                      (home-emacs-configuration-emacs config)
                   "--fg-daemon" "--eval"
                   (format #f "~s"
                             (setq custom-file
                                   (concat (or (getenv "XDG_CONFIG_HOME")
                                               (concat (getenv "HOME")
                             (load custom-file)))
                   #$@(if (home-emacs-configuration-debug? config)
                          (list "--debug-init")
             (format #f "~a/emacs.log"
                     (or (getenv "XDG_LOG_HOME")
                         (format #f "~a/.local/var/log"
                                 (getenv "HOME"))))
             (let ((env-var
                    (lambda (name path)
                      (define (regular-directory? directory)
                        (not (member directory (list "." ".."))))
(define (make-emacs-profile config)
  (match-record config <home-emacs-configuration> (packages)
     (name "emacs-profile")
     (content (packages->manifest (cons (emacs-for-compile config)

                      (define (package-paths package)
                        (let ((directory (string-append package "/" path)))
                          (if (file-exists? directory)
                              (cons directory
                                    (map (cute string-append directory "/" <>)
                                         (scandir directory regular-directory?)))
(define not-config?
  ;; Select (guix …) and (gnu …) modules, except (guix config).
    (('guix 'config) #f)
    ((or ('gnu rest ...)
         ('guix rest ...))
    (rest #f)))

                      (let ((old-value (getenv name)))
                         name "="
                           (list #$@(home-emacs-transformed-packages config)))
                          ":" (if old-value
                         (or old-value ""))))))
               (append (default-environment-variables)
                       (list (env-var "EMACSLOADPATH"
                             (env-var "EMACSNATIVELOADPATH"
             (list #$(file-append
                      (home-emacs-configuration-emacs config)
                   "--eval" "(kill-emacs)"))))))
(define (build-emacs-profile config)
  (with-store store
    (run-with-store store
      (mlet %store-monad
          ((profile-drv (lower-object
                         (make-emacs-profile config))))
        (mbegin %store-monad
          (built-derivations (list profile-drv))
          (return (derivation-output-path
                   (assoc-ref (derivation-outputs profile-drv)

(define (emacs-environment config)
  (with-imported-modules (source-module-closure '((guix search-paths)))
        (use-modules (guix search-paths))
        (map (lambda (env-var)
               (let ((variable (list-ref env-var 0))
                     (separator (list-ref env-var 1))
                     (value (list-ref env-var 2)))
                 (string-append variable "="
                                (or (and=> (getenv variable)
                                           (lambda (original)
                                             (string-append original
             '(#$@(map (match-lambda
                         ((spec . value)
                          (match-record spec <search-path-specification>
                              (variable separator)
                            (list variable separator value))))
                        (build-emacs-profile config))))))))

(define (home-emacs-profile-packages config)
  (match-record config <home-emacs-configuration> (emacs)
    (list emacs)))

(define (home-emacs-shepherd-services config)
  (match-record config <home-emacs-configuration> (servers emacs debug?)
    (map (lambda (server)
            (provision (list (string->symbol
                              (string-append "emacs-" server))))
             (string-append "Start the Emacs server called "
                            server "."))
                (list #$(file-append emacs "/bin/emacs")
                      (string-append "--fg-daemon=" #$server)
                      #$@(if debug?
                             (list "--debug-init")
                (list (endpoint
                        (format #f "/run/user/~a/emacs/~a"
                                (getuid) #$server))))
                (format #f "~a/log/emacs/~a.log"
                        (or (getenv "XDG_STATE_HOME")
                            (format #f "~a/.local/state"
                                    (getenv "HOME")))
                (append (default-environment-variables)
                        #$(emacs-environment config))))
                (list #$(file-append emacs "/bin/emacsclient")
                      "-s" #$server "--eval" "(kill-emacs)")))))

(define (home-emacs-xdg-configuration-files config)
     ,(home-emacs-configuration-early-init-file config))
     ,(home-emacs-configuration-init-file config))))
  (match-record config <home-emacs-configuration> (early-init-file
       ,(home-emacs-configuration-early-init-file config))
       ,(home-emacs-configuration-init-file config)))))

(define home-emacs-service-type