@@ 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
- emacs)
+ #: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
home-emacs-service-type))
+(define list-of-string?
+ (list-of string?))
+
(define list-of-file-likes?
(list-of file-like?))
+(define file-like-or-#f?
+ (match-lambda
+ ((or #f
+ (? file-like?)) #t)
+ (_ #f)))
+
(define-configuration/no-serialization home-emacs-configuration
+ (servers
+ (list-of-string (list "server"))
+ "List of strings which name Emacs servers to run.")
(emacs
(file-like emacs)
"The package providing @file{/bin/emacs}.")
(packages
(list-of-file-likes '())
- "Packages to add to the Emacs plugin load path.")
+ "Packages to add to the Emacs load path.")
(native-compile?
(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.")
+ (compilation-emacs
+ (file-like-or-#f #f)
+ "The Emacs package to use to compile Emacs packages. If #F, default to
+EMACS-MINIMAL.")
(init-file
(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.")
(early-init-file
(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.")
(debug?
(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)
+ (cond
+ (compilation-emacs compilation-emacs)
+ (native-compile? emacs)
+ (else emacs-minimal))))
-(define (home-emacs-transformed-packages config)
- (map (if (home-emacs-configuration-native-compile? config)
- (package-input-rewriting
- `((,emacs-minimal
- . ,(home-emacs-configuration-emacs config))))
- identity)
- (let ((packages (home-emacs-configuration-packages config)))
- (concatenate
- (cons packages
- (map (compose (cute map second <>)
- package-transitive-propagated-inputs)
- packages))))))
+(define (transformed-emacs-packages config)
+ (match-record config <home-emacs-configuration> (packages)
+ (map (package-input-rewriting
+ `((,emacs-minimal . ,(emacs-for-compile config))))
+ packages)))
-(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)))
- (start
- #~(make-forkexec-constructor
- (list #$(file-append
- (home-emacs-configuration-emacs config)
- "/bin/emacs")
- "--fg-daemon" "--eval"
- (format #f "~s"
- `(progn
- (setq custom-file
- (concat (or (getenv "XDG_CONFIG_HOME")
- (concat (getenv "HOME")
- "/.config"))
- "/emacs/custom.el"))
- (load custom-file)))
- #$@(if (home-emacs-configuration-debug? config)
- (list "--debug-init")
- '()))
- #:log-file
- (format #f "~a/emacs.log"
- (or (getenv "XDG_LOG_HOME")
- (format #f "~a/.local/var/log"
- (getenv "HOME"))))
- #:environment-variables
- (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)
+ (profile
+ (name "emacs-profile")
+ (content (packages->manifest (cons (emacs-for-compile config)
+ packages))))))
- (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).
+ (match-lambda
+ (('guix 'config) #f)
+ ((or ('gnu rest ...)
+ ('guix rest ...))
+ #t)
+ (rest #f)))
- (let ((old-value (getenv name)))
- (string-append
- name "="
- (string-join
- (append-map
- package-paths
- (list #$@(home-emacs-transformed-packages config)))
- ":" (if old-value
- 'suffix
- 'infix))
- (or old-value ""))))))
- (append (default-environment-variables)
- (list (env-var "EMACSLOADPATH"
- "share/emacs/site-lisp")
- (env-var "EMACSNATIVELOADPATH"
- "lib/emacs/native-site-lisp"))))))
- (stop
- #~(make-forkexec-constructor
- (list #$(file-append
- (home-emacs-configuration-emacs config)
- "/bin/emacsclient")
- "--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)
+ "out"))))))))
+
+(define (emacs-environment config)
+ (with-imported-modules (source-module-closure '((guix search-paths)))
+ #~(begin
+ (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
+ separator)))
+ "")
+ value)))
+ '(#$@(map (match-lambda
+ ((spec . value)
+ (match-record spec <search-path-specification>
+ (variable separator)
+ (list variable separator value))))
+ (profile-search-paths
+ (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)
+ (shepherd-service
+ (provision (list (string->symbol
+ (string-append "emacs-" server))))
+ (documentation
+ (string-append "Start the Emacs server called "
+ server "."))
+ (start
+ #~(make-systemd-constructor
+ (list #$(file-append emacs "/bin/emacs")
+ (string-append "--fg-daemon=" #$server)
+ #$@(if debug?
+ (list "--debug-init")
+ '()))
+ (list (endpoint
+ (make-socket-address
+ AF_UNIX
+ (format #f "/run/user/~a/emacs/~a"
+ (getuid) #$server))))
+ #:log-file
+ (format #f "~a/log/emacs/~a.log"
+ (or (getenv "XDG_STATE_HOME")
+ (format #f "~a/.local/state"
+ (getenv "HOME")))
+ #$server)
+ #:environment-variables
+ (append (default-environment-variables)
+ #$(emacs-environment config))))
+ (stop
+ #~(make-forkexec-constructor
+ (list #$(file-append emacs "/bin/emacsclient")
+ "-s" #$server "--eval" "(kill-emacs)")))))
+ servers)))
(define (home-emacs-xdg-configuration-files config)
- `(("emacs/early-init.el"
- ,(home-emacs-configuration-early-init-file config))
- ("emacs/init.el"
- ,(home-emacs-configuration-init-file config))))
+ (match-record config <home-emacs-configuration> (early-init-file
+ init-file)
+ `(("emacs/early-init.el"
+ ,(home-emacs-configuration-early-init-file config))
+ ("emacs/init.el"
+ ,(home-emacs-configuration-init-file config)))))
(define home-emacs-service-type
(service-type