Copy rde/emacs services files; remove rde channel

Current combination of channels, the abcdw/rde channel cannot build.
Currently, only the home-emacs-service is being used.

Signed-off-by: Kenny Ballou <kb@devnulllabs.io>

2 files changed, 824 insertions, 0 deletions

diff --git a/gnu/home-services-utils.scm b/gnu/home-services-utils.scm
new file mode 100644
index 00000000..5bebb1c4
--- /dev/null
+++ b/gnu/home-services-utils.scm
@@ -0,0 +1,452 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu home-services-utils)
+  #:use-module (gnu services configuration)
+  #:use-module (gnu home services utils)
+  #:use-module (guix ui)
+  #:use-module (guix diagnostics)
+  #:use-module (guix gexp)
+  #:use-module (guix monads)
+  #:use-module (guix i18n)
+  #:use-module (guix profiles)
+  #:use-module (guix packages)
+  #:use-module (guix build-system trivial)
+
+  #:use-module (ice-9 curried-definitions)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 string-fun)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-171)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-43)
+
+  #:re-export (filter-configuration-fields
+
+               list-of
+
+               list-of-strings?
+               alist?
+               text-config?
+               serialize-text-config
+               generic-serialize-alist-entry
+               generic-serialize-alist
+
+               maybe-object->string
+               object->snake-case-string
+               object->camel-case-string)
+
+  #:export (slurp-file-gexp
+
+            alist-entry->mixed-text
+            boolean->yes-or-no
+            boolean->true-or-false
+            list->human-readable-list
+
+            ini-config?
+            generic-serialize-ini-config
+            generic-serialize-git-ini-config
+
+            yaml-config?
+            serialize-yaml-config
+
+            string-or-gexp?
+            serialize-string-or-gexp
+
+            gexp-text-config?
+            serialize-gexp-text-config
+
+            rest
+            maybe-list
+            optional
+            wrap-package
+
+            define-enum
+            enum-name
+            enum-value))
+
+
+;;;
+;;; User's utils.
+;;;
+
+(define* (slurp-file-gexp file #:key (encoding "UTF-8"))
+  "Returns a gexp, which reads all the content of the FILE and returns
+it as a string.  FILE must be a file-like object."
+  (when (not (file-like? file))
+    (raise (formatted-message
+            (G_ "~a is not a file-like object.")
+            file)))
+  #~(call-with-input-file #$file
+      (@ (ice-9 textual-ports) get-string-all)
+      #:encoding #$encoding))
+
+
+;;;
+;;; Configuration related helpers.
+;;;
+
+(define* ((alist-entry->mixed-text prefix sep #:optional (suffix "\n"))
+          alist-entry)
+  "Create a list from ALIST-ENTRY, which can be used with
+@code{mixed-text-file} for example to create key-value configuration
+file or shell script.
+
+PREFIX is the string to prefix the key-value pair with.  For example,
+@code{\"export\"} will return @code{'(\"export\" KEY SEP VALUE)},
+where KEY is the first element of ALIST-ENTRY, and VALUE is the second
+element of ALIST-ENTRY.
+
+SEP is the separator between the key and the value.
+
+SUFFIX is the optional argument, default to newline.
+
+Different things will happen depending on the value of VALUE:
+@itemize @bullet
+@item If VALUE is #f, ignore everything in the entry and just return
+an empty list.
+
+@item If VALUE is #t or not provided (empty list), ignore the VALUE
+and SEP and just return a list of PREFIX and KEY followed by a
+SUFFIX.
+
+@item If VALUE is a flat list, it will get added to the resulting
+list. If not flat the exception will be raised.
+
+@item If VALUE is not a list (string, file-like object, etc), return a
+list of PREFIX, KEY, SEP and VALUE followed by a SUFFIX.
+
+The following code
+@lisp
+((alist-entry->mixed-text \"export \" \"=\") '(\"EDITOR\" . \"emacsclient\"))
+((alist-entry->mixed-text \"export \" \"=\") '(\"EDITOR\" . #t))
+((alist-entry->mixed-text \"export \" \"=\") '(\"EDITOR\"))
+((alist-entry->mixed-text \"export \" \"=\") '(\"EDITOR\" . #f))
+((alist-entry->mixed-text \"export \" \"=\") '(\"EDITOR\" . (\"emacsclient\" \"vim\")))
+@end lisp
+
+would yield
+
+@example
+(\"export \" \"EDITOR\" \"=\" \"emacsclient\" \"\n\")
+(\"export \" \"EDITOR\" \"\n\")
+(\"export \" \"EDITOR\" \"\n\")
+()
+(\"export \" \"EDITOR\" \"=\" \"emacsclient\" \"vim\" \"\n\")
+@end example"
+  (define (not-alist-entry-error)
+    (raise (formatted-message
+            (G_ "~a has to be an association list entry")
+            alist-entry)))
+  (match alist-entry
+    ((key . value)
+     (let* ((values (cond
+                    ((eq? value #f)
+                     #f)
+                    ((or (eq? value #t) (null? value))
+                     '(""))
+                    ((list? value)
+                     (if (any list? value)
+                         (raise (formatted-message
+                                 (G_ "~a is not a flat list")
+                                 value))
+                         value))
+                    (else
+                     (list value))))
+           (sep (if (eq? values '(""))
+                    ""
+                    sep)))
+       (if values
+           `(,prefix ,key ,sep ,@values ,suffix)
+           '())))
+    (_ (not-alist-entry-error))))
+
+(define* (boolean->yes-or-no bool #:optional (capitalize? #f))
+  "Convert a boolean BOOL to \"yes\" or \"no\".
+Setting CAPITALIZE? to @code{#t} will capitalize the word, it is set to
+@code{#f} by default."
+  (let ((word (if (eq? bool #t) "yes" "no")))
+    (if capitalize?
+        (string-capitalize word)
+        word)))
+
+(define* (boolean->true-or-false bool #:optional (capitalize? #f))
+  "Convert a boolean BOOL to \"true\" or \"false\".
+Setting CAPITALIZE? to @code{#t} will capitalize the word, it is set to
+@code{#f} by default."
+  (let ((word (if bool "true" "false")))
+    (if capitalize?
+        (string-capitalize word)
+        word)))
+
+;; TODO: Remove once upstreamed
+(define* (list->human-readable-list lst
+                                    #:key
+                                    (cumulative? #f)
+                                    (proc identity))
+  "Turn a list LST into a sequence of terms readable by humans.
+If CUMULATIVE? is @code{#t}, use ``and'', otherwise use ``or'' before
+the last term.
+
+PROC is a procedure to apply to each of the elements of a list before
+turning them into a single human readable string.
+
+@example
+(list->human-readable-list '(1 4 9) #:cumulative? #t #:proc sqrt)
+@result{} \"1, 2, and 3\"
+@end example
+
+yields:"
+  (let* ((word (if cumulative? "and " "or "))
+         (init (append (drop-right lst 1))))
+    (format #f "~a" (string-append
+                     (string-join
+                      (map (compose maybe-object->string proc) init)
+                      ", " 'suffix)
+                     word
+                     (maybe-object->string (proc (last lst)))))))
+
+
+
+;;;
+;;; Serializers.
+;;;
+
+(define ini-config? list?)
+(define (generic-serialize-ini-config-section section proc)
+  "Format a section from SECTION for an INI configuration.
+Apply the procedure PROC on SECTION after it has been converted to a string"
+  (format #f "[~a]\n" (proc section)))
+
+(define default-ini-format-section
+  (match-lambda
+    ((section subsection)
+     (string-append (maybe-object->string section) " "
+                    (maybe-object->string subsection)))
+    (section
+     (maybe-object->string section))))
+
+(define* (generic-serialize-ini-config
+          #:key
+          (combine-ini string-join)
+          (combine-alist string-append)
+          (combine-section-alist string-append)
+          (format-section default-ini-format-section)
+          serialize-field
+          fields)
+  "Create an INI configuration from nested lists FIELDS.  This uses
+@code{generic-serialize-ini-config-section} and @{generic-serialize-alist} to
+serialize the section and the association lists, respectively.
+
+@example
+(generic-serialize-ini-config
+ #:serialize-field (lambda (a b) (format #f \"~a = ~a\n\" a b))
+ #:format-section (compose string-capitalize symbol->string)
+ #:fields '((application ((key . value)))))
+@end example
+
+@result{} \"[Application]\nkey = value\n\""
+  (combine-ini
+   (map (match-lambda
+          ((section alist)
+           (combine-section-alist
+            (generic-serialize-ini-config-section section format-section)
+            (generic-serialize-alist combine-alist serialize-field alist))))
+        fields)
+   "\n"))
+
+(define* (generic-serialize-git-ini-config
+          #:key
+          (combine-ini string-join)
+          (combine-alist string-append)
+          (combine-section-alist string-append)
+          (format-section default-ini-format-section)
+          serialize-field
+          fields)
+  "Like @code{generic-serialize-ini-config}, but the section can also
+have a @dfn{subsection}.  FORMAT-SECTION will take a list of two
+elements: the section and the subsection."
+  (combine-ini
+   (map (match-lambda
+          ((section subsection alist)
+           (combine-section-alist
+            (generic-serialize-ini-config-section
+             (list section subsection) format-section)
+            (generic-serialize-alist combine-alist serialize-field alist)))
+          ((section alist)
+           (combine-section-alist
+            (generic-serialize-ini-config-section section format-section)
+            (generic-serialize-alist combine-alist serialize-field alist))))
+        fields)
+   "\n"))
+
+(define yaml-config? list?)
+(define (make-yaml-indent depth)
+  (make-string (* 2 depth) #\space))
+
+(define ((serialize-yaml-value depth) value)
+  (let* ((tab (make-yaml-indent depth)))
+    (cond
+     ((string? value)
+      (list (format #f "'~a'" value)))
+     ((boolean? value)
+      (list (format #f "~a" (if value "true" "false"))))
+     ((file-like? value)
+      (list value))
+     ((alist? value)
+      (serialize-yaml-alist value #:depth (1+ depth)))
+     ((vector? value)
+      (serialize-yaml-vector value #:depth depth))
+     (else (list (format #f "~a" value))))))
+
+(define ((serialize-yaml-key depth) key)
+  (when (vector? key)
+    (raise (formatted-message
+            (G_ "Vector as key value are not supported by serializer, \
+try to avoid them. ~a") key)))
+  ((serialize-yaml-value depth) key))
+
+(define ((serialize-yaml-key-value depth) key value)
+  (let ((tab (make-yaml-indent depth)))
+    `("\n"
+      ,tab
+      ,@((serialize-yaml-key depth) key) ": "
+      ,@((serialize-yaml-value depth) value))))
+
+(define ((serialize-yaml-vector-elem depth) elem)
+  (let ((tab (make-yaml-indent (1+ depth))))
+    (cons*
+     "\n" tab "- "
+     ((serialize-yaml-value (1+ depth)) elem))))
+
+(define* (serialize-yaml-vector vec #:key (depth 0))
+  (append-map (serialize-yaml-vector-elem depth) (vector->list vec)))
+
+(define* (serialize-yaml-alist lst #:key (depth 0))
+  (generic-serialize-alist append (serialize-yaml-key-value depth) lst))
+
+(define (serialize-yaml-config config)
+  "Simplified yaml serializer, which supports only a subset of yaml, use
+it with caution."
+  (serialize-yaml-alist config))
+
+(define (string-or-gexp? sg) (or (string? sg) (gexp? sg)))
+(define (serialize-string-or-gexp field-name val) "")
+
+;; Guix proper has a different version of text-config.
+(define (gexp-text-config? config)
+  (and (list? config) (every string-or-gexp? config)))
+(define (serialize-gexp-text-config field-name val)
+  #~(string-append #$@(interpose val "\n" 'suffix)))
+
+;;;
+;;; Miscellaneous.
+;;;
+
+(define rest cdr)
+
+;; Confusing with maybe-list type.
+(define (maybe-list a)
+  "If A is a list, return it, otherwise return a singleton list with A."
+      (if (list? a)
+          a
+          (list a)))
+
+;; If EXPR1 evaluates to a non-@code{#f} value and EXPR2 is specified,
+;; return EXPR2; if it isn't specified, return EXPR1.  Otherwise, return
+;; an empty list @code{'()}.
+(define-syntax optional
+  (syntax-rules ()
+    ((_ expr1)
+     (if expr1 expr1 '()))
+    ((_ expr1 expr2)
+     (if expr1 expr2 '()))))
+
+(define (wrap-package pkg executable-name gexp)
+  "Create a @code{<package>} object that is a wrapper for PACKAGE, and
+runs GEXP.  NAME is the name of the executable that will be put in the store."
+  (let* ((wrapper-name (string-append executable-name "-wrapper"))
+         (wrapper (program-file wrapper-name gexp)))
+    (package
+      (inherit pkg)
+      (name wrapper-name)
+      (source wrapper)
+      (propagated-inputs `((,(package-name pkg) ,pkg)))
+      (build-system trivial-build-system)
+      (arguments
+       `(#:modules
+         ((guix build utils))
+         #:builder
+         (begin
+           (use-modules (guix build utils)
+                        (srfi srfi-1))
+           (let* ((bin (string-append %output "/bin"))
+                  (wrapper (assoc-ref %build-inputs "source")))
+             (mkdir-p bin)
+             (copy-file wrapper (string-append bin "/" ,executable-name)))))))))
+
+
+;;;
+;;; Enums.
+;;;
+
+(define-record-type <enum>
+  (make-enum name value)
+  enum?
+  (name enum-name)
+  (value enum-value))
+
+;; Copied from (gnu services configuration)
+(define-syntax-rule (id ctx parts ...)
+  "Assemble PARTS into a raw (unhygienic)  identifier."
+  (datum->syntax ctx (symbol-append (syntax->datum parts) ...)))
+
+;; (define-enum pinentry-flavor
+;;   '(emacs gtk qt ncurses tty))
+;;
+;; (pinentry-flavor? 'gtk)
+;; => #t
+;;
+;; (enum-value pinentry-flavor)
+;; => '(emacs gtk qt ncurses tty)
+;;
+;; (pinentry-flavor? 'vim)
+;; exception: `pinetry-flavor' must be one of `emacs', `gtk', `qt',
+;; `ncurses', or `tty', was given `vim'
+
+(define-syntax define-enum
+  (lambda (x)
+    (syntax-case x ()
+      ((_ stem value)
+       (with-syntax ((stem? (id #'stem #'stem #'?))
+                     (msg (list->human-readable-list
+                           (second (syntax->datum #'value))
+                           #:proc (cut format #f "`~a'" <>))))
+         #'(begin
+             (define stem (make-enum (quote stem) value))
+
+             (define (stem? val)
+               (if (member val value)
+                   #t
+                   (raise (formatted-message
+                           (G_ "`~a' must of ~a, was given: ~s")
+                           (enum-name stem)
+                           (syntax->datum msg)
+                           val))))))))))
diff --git a/gnu/home-services/emacs.scm b/gnu/home-services/emacs.scm
new file mode 100644
index 00000000..ff3dda06
--- /dev/null
+++ b/gnu/home-services/emacs.scm
@@ -0,0 +1,372 @@
+(define-module (gnu home-services emacs)
+  #:use-module (gnu home services)
+  #:use-module (gnu home-services-utils)
+  #:use-module (gnu home services shepherd)
+  #:use-module (gnu packages emacs)
+  #:use-module (gnu services configuration)
+
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 curried-definitions)
+  #:use-module (ice-9 pretty-print)
+
+  #:use-module (guix packages)
+  #:use-module (guix gexp)
+  #:use-module (guix utils)
+  #:use-module (guix build-system emacs)
+  #:use-module ((guix licenses) #:prefix license:)
+  #:export (home-emacs-service-type
+            home-emacs-configuration
+            home-emacs-extension
+            elisp-configuration-package))
+
+(define packages? (list-of package?))
+
+(define serialize-packages empty-serializer)
+(define serialize-boolean empty-serializer)
+
+(define elisp-config? list?)
+(define (serialize-elisp-config field-name val)
+  (define (serialize-list-element elem)
+    (cond
+     ((gexp? elem)
+      elem)
+     (else
+      #~(string-trim-right
+         (with-output-to-string
+           (lambda ()
+             ((@ (ice-9 pretty-print) pretty-print)
+              '#$elem
+              #:max-expr-width 79)))
+         #\newline))))
+
+  #~(string-append
+     #$@(interpose
+         (map serialize-list-element val)
+         "\n" 'suffix)))
+
+(define-configuration home-emacs-configuration
+  (package
+    (package emacs)
+    "Emacs package to use.")
+  (elisp-packages
+   (packages '())
+   "List of Emacs Lisp packages to install.")
+  (rebuild-elisp-packages?
+   (boolean #f)
+   "Rebuild Emacs Lisp packages with version of Emacs specified in
+PACKAGE field.")
+  (server-mode?
+   (boolean #f)
+   "Create a shepherd service, which starts emacs in a server-mode.  Use
+can use @command{emacsclient} to connect to the server (@pxref{Emacs
+Server,,,emacs.info}).")
+  (xdg-flavor?
+   (boolean #t)
+   "Whether to place all the configuration files in
+@file{$XDG_CONFIG_HOME/emacs}.")
+  (init-el
+   (elisp-config '())
+   "List of expressions, each expression can be a Sexp or Gexp.
+
+Sexp is a Emacs Lisp form, preferably valid.  Be aware, if you include
+values of Guile variables, they won't be automatically converted to
+Elisp.  Strings doesn't require conversion, but for example booleans
+do: @code{#t} -> @code{t}, @code{#f} -> @code{nil}.  Be careful here.
+
+However, Sexp can contain file-like objects; String with path to a
+corresponding file will appear in place of each such object.  See an
+example below for more details.
+
+Gexp should be string-valued.  The value of Gexp will be appended to
+resulting Emacs Lisp file.
+
+The list of expressions will be interposed with \\n and everything
+will end up in @file{init.el}.
+
+@example
+(let ((guile-bool-value #f))
+  (home-emacs-configuration
+   (init-el
+    `((setq rg-binary ,(file-append ripgrep \"/bin/rg\"))
+      (load-file ,(local-file \"./emacs/test-init.el\"))
+      \"just a string\"
+      ;; Make sure you converted guile values to Elisp
+      (setq tmp-boolean ,(if guile-bool-value 't 'nil))
+      ,(if guile-bool-value '(setq v1 nil) '(setq v2 t))
+
+      ,#~\"\\n;;; Section with gexps results:\"
+
+      ,(slurp-file-gexp (local-file \"./emacs/test-init.el\"))
+      ,#~(string-append \"(princ \" \"'hello)\")
+      ,#~\"\\n\"
+      ,#~\";; Another comment\"))))
+@end example
+
+would yield something like:
+
+@example
+(setq rg-binary
+      \"/gnu/store/dw884p9d2jb83j4fqvdj2i10fn9xgwqd-ripgrep-12.1.1/bin/rg\")
+(load-file
+  \"/gnu/store/9b1s48crng5dy9xmxskcdnillw18bkg2-test-init.el\")
+\"just a string\"
+(setq tmp-boolean nil)
+(setq v2 t)
+
+;;; Section with gexps results:
+;; Here is
+\"a sample\"
+;; content of test-init.el
+
+(princ 'hello)
+
+
+;; Another comment
+@end example")
+  (early-init-el
+   (elisp-config '())
+   "List of expressions, each expression can be a Sexp or Gexp.
+Same as @code{init-el}, but result will go to @file{early-init.el}."))
+
+
+(define ((update-emacs-argument-for-package target-emacs) p)
+  "Set @code{#:emacs} to EMACS-PACKAGE for package P.  To build elisp
+packages with proper GNU Emacs version."
+  (if (equal?
+       (package-build-system p)
+       emacs-build-system)
+      (package
+        (inherit p)
+        (arguments
+         (substitute-keyword-arguments (package-arguments p)
+           ((#:emacs e #f) target-emacs))))
+      p))
+
+(define (emacs-argument-updater target-emacs)
+  "Recursively updates @code{#:emacs} argument for package and all the
+inputs."
+  (package-mapping (update-emacs-argument-for-package target-emacs)
+                   (lambda (p) #f)))
+
+(define (updated-elisp-packages config)
+  (let* ((emacs-package  (home-emacs-configuration-package config))
+         (elisp-packages (home-emacs-configuration-elisp-packages config))
+
+         (updated-elisp-packages
+          (if (home-emacs-configuration-rebuild-elisp-packages? config)
+              (map (emacs-argument-updater emacs-package)
+                   elisp-packages)
+              elisp-packages)))
+    updated-elisp-packages))
+
+(define (add-emacs-packages config)
+  (append (updated-elisp-packages config)
+          ;; It's important for packages to go first to override
+          ;; built-in emacs packages in case of collisions
+          (list (home-emacs-configuration-package config))))
+
+
+(define (add-emacs-shepherd-service config)
+  (optional (home-emacs-configuration-server-mode? config)
+            (list (shepherd-service
+                   (documentation "Emacs server.  Use @code{emacsclient} to
+connect to it.")
+                   (provision '(emacs-server))
+                   (start #~(make-forkexec-constructor
+                             (list #$(file-append
+                                      (home-emacs-configuration-package config)
+                                      "/bin/emacs") "--fg-daemon")
+                             #:log-file (string-append
+                                         (or (getenv "XDG_LOG_HOME")
+                                             (format #f "~a/.local/var/log"
+                                                     (getenv "HOME")))
+                                         "/emacs.log")))
+                   (stop #~(make-kill-destructor))))))
+
+;; (define* (mixed-text-file name #:rest text)
+;;   "Return an object representing store file NAME containing TEXT.  TEXT is a
+;; sequence of strings and file-like objects, as in:
+
+;;   (mixed-text-file \"profile\"
+;;                    \"export PATH=\" coreutils \"/bin:\" grep \"/bin\")
+
+;; This is the declarative counterpart of 'text-file*'."
+;;   (define build
+;;     (gexp (call-with-output-file (ungexp output "out")
+;;             (lambda (port)
+;;               ;; TODO: Upstream the fix?
+;;               (set-port-encoding! port "UTF-8")
+;;               (display (string-append (ungexp-splicing text)) port)))))
+
+;;   (computed-file name build))
+
+(define (get-emacs-configuration-files config)
+  (let* ((xdg-flavor? (home-emacs-configuration-xdg-flavor? config)))
+    (define prefix-file
+      (cut string-append
+           (if xdg-flavor?
+               "emacs/"
+               "emacs.d/")
+           <>))
+
+    (define (filter-fields field)
+      (filter-configuration-fields home-emacs-configuration-fields
+                                   (list field)))
+
+    (define (serialize-field field)
+      (serialize-configuration
+       config
+       (filter-fields field)))
+
+    (define (file-if-not-empty field)
+      (let ((file-name (string-append
+                        (string-drop-right (symbol->string field) 3)
+                        ".el"))
+            (field-obj (car (filter-fields field))))
+        (optional (not (null? ((configuration-field-getter field-obj) config)))
+                  `(,(prefix-file file-name)
+                    ,(mixed-text-file
+                      file-name
+                      (serialize-field field))))))
+
+    (filter
+     (compose not null?)
+     (list
+      (file-if-not-empty 'init-el)
+      (file-if-not-empty 'early-init-el)))))
+
+(define (add-emacs-dot-configuration config)
+  (if (home-emacs-configuration-xdg-flavor? config)
+      '()
+      (get-emacs-configuration-files config)))
+
+(define (add-emacs-xdg-configuration config)
+  (if (home-emacs-configuration-xdg-flavor? config)
+      (get-emacs-configuration-files config)
+      '()))
+
+(define-configuration home-emacs-extension
+  (elisp-packages
+   (packages '())
+   "List of additional Emacs Lisp packages.")
+  (init-el
+   (elisp-config '())
+   "List of expressions to add to @code{init-el}.  See
+@code{home-emacs-service-type} for more information.")
+  (early-init-el
+   (elisp-config '())
+   "List of expressions to add to @code{ealy-init-el}.  See
+@code{home-emacs-service-type} for more information."))
+
+(define (home-emacs-extensions original-config extension-configs)
+  (home-emacs-configuration
+   (inherit original-config)
+   (elisp-packages
+    (append (home-emacs-configuration-elisp-packages original-config)
+            (append-map
+             home-emacs-extension-elisp-packages extension-configs)))
+   (init-el
+    (append (home-emacs-configuration-init-el original-config)
+            (append-map
+             home-emacs-extension-init-el extension-configs)))
+   (early-init-el
+    (append (home-emacs-configuration-early-init-el original-config)
+            (append-map
+             home-emacs-extension-early-init-el extension-configs)))))
+
+
+(define home-emacs-service-type
+  (service-type (name 'home-emacs)
+                (extensions
+                 (list (service-extension
+                        home-profile-service-type
+                        add-emacs-packages)
+                       (service-extension
+                        home-shepherd-service-type
+                        add-emacs-shepherd-service)
+                       (service-extension
+                        home-files-service-type
+                        add-emacs-dot-configuration)
+                       (service-extension
+                        home-xdg-configuration-files-service-type
+                        add-emacs-xdg-configuration)))
+                (compose identity)
+                (extend home-emacs-extensions)
+                (default-value (home-emacs-configuration))
+                (description "Install and configure GNU Emacs, the
+extensible, self-documenting editor.")))
+
+(define (generate-home-emacs-documentation)
+  (generate-documentation
+   `((home-emacs-configuration
+      ,home-emacs-configuration-fields))
+   'home-emacs-configuration))
+
+
+(define* (elisp-configuration-package
+          package-name elisp-expressions
+          #:key
+          summary authors maintainers url keywords commentary
+          (elisp-packages '())
+          (autoloads? #t))
+  "Takes a list of Elisp expressions, create emacs-NAME package.
+@code{#~\";;;###autoload\"} can be used to make next expression be
+loaded on startup."
+
+  (define (package->package-input pkg)
+    (list ((@ (guix packages) package-name) pkg) pkg))
+
+  (define (add-autoloads elisp-expressions)
+    (fold-right
+     (lambda (e acc)
+       (if (list? e)
+           (cons* #~";;;###autoload" e #~"" acc)
+           (cons* e #~"" acc)))
+     '() elisp-expressions))
+
+  (package
+    (name (string-append "emacs-" package-name))
+    (version "1.0.0")
+    (build-system emacs-build-system)
+    (source
+     (mixed-text-file
+      (string-append package-name ".el")
+      (serialize-elisp-config
+       #f
+       (append
+        ;; <https://www.gnu.org/software/emacs/manual/html_node/elisp/Library-Headers.html>
+        (list #~(format #f ";;; ~a.el --- ~a\n" #$package-name
+                        (or #$summary "No description provided")))
+        (if authors
+            (list #~(format #f ";; Author: ~a\n;;"
+                            #$(string-join authors "\n;;         ")))
+            '())
+        (if maintainers
+            (list #~(format #f ";; Maintainer: ~a\n;;"
+                            #$(string-join maintainers "\n;;             ")))
+            '())
+        (if url (list #~(format #f ";; URL: ~a" #$url)) '())
+        (if keywords
+            (list #~#$(format #f ";; Keywords: ~a"
+                              (string-join (map object->string keywords) ", ")))
+            '())
+        (if commentary
+            (list #~"\n;;; Commentary:\n"
+                  #~#$(string-join
+                       (map
+                        (lambda (x)
+                          (if (string-null? x)
+                              x
+                              (string-append ";; " x)))
+                        (string-split commentary #\newline)) "\n"))
+            '())
+        (list #~"\n;;; Code:\n")
+        ((if autoloads? add-autoloads identity) elisp-expressions)
+        (list `(provide ',(string->symbol package-name))
+              #~#$(format #f"\n;;; ~a.el ends here" package-name))))))
+    (propagated-inputs (map package->package-input elisp-packages))
+    (synopsis (or summary "Generated Emacs configuration package"))
+    (description "Package generated by @code{elisp-configuration-package}.")
+    (home-page "https://www.gnu.org/software/guix/")
+    (license license:gpl3+)))