path: root/oni/home/services/emacs.scm

(define-module (oni home services emacs)
  #:use-module ((gnu services configuration)
                #:select (serialize-package
                          define-configuration
                          define-configuration/no-serialization
                          text-config?
                          serialize-text-config
                          define-maybe
                          maybe-value-set?))
  #:use-module ((gnu packages emacs)
                #:select (emacs))
  #:use-module ((gnu packages emacs-xyz)
                #:select (emacs-helpful
                          emacs-dashboard
                          emacs-eros
                          emacs-ace-link
                          emacs-pinentry
                          emacs-vterm))
  #:use-module ((gnu home services)
                #:select (service-type
                          service-extension
                          home-profile-service-type
                          home-files-service-type))
  #:use-module ((gnu home services shells)
                #:select (home-zsh-extension
                          home-zsh-service-type))
  #:use-module ((gnu home services shepherd)
                #:select (shepherd-service
                          home-shepherd-service-type))
  #:use-module ((guix gexp)
                #:select (gexp
                          file-append
                          local-file
                          mixed-text-file))
  #:use-module ((guix packages)
                #:select (package?))
  #:use-module ((oni packages emacs)
                #:select (emacs-yasnippet-capf
                          emacs-golden-ratio
                          emacs-ace-link-notmuch))

  #:export (home-emacs-service-type
            home-emacs-configuration

            home-emacs-helpful-service-type
            home-emacs-helpful-configuration

            home-emacs-yasnippet-capf-service-type
            home-emacs-yasnippet-capf-configuration

            home-emacs-dashboard-service-type
            home-emacs-dashboard-configuration

            home-emacs-eros-service-type
            home-emacs-eros-configuration

            home-emacs-ace-link-service-type
            home-emacs-ace-link-configuration

            home-emacs-ace-link-notmuch-service-type
            home-emacs-ace-link-notmuch-configuration

            home-emacs-golden-ratio-service-type
            home-emacs-golden-ratio-configuration

            home-emacs-pinentry-service-type
            home-emacs-pinentry-configuration

            home-emacs-vterm-service-type
            home-emacs-vterm-configuration))

(define-maybe string)

;;; Emacs

(define-configuration/no-serialization home-emacs-extension
  (configurations
   (text-config '())
   "The configuration for the extension."))

(define-configuration home-emacs-configuration
  (package
    (package emacs)
    "Package to use for setting Emacs")
  (configurations
   (text-config '())
   "A list of other configuration files to autoload"))

(define (add-emacs-packages config)
  (list (home-emacs-configuration-package config)))

(define (home-emacs-extensions original-config extension-configs)
  (home-emacs-configuration
   (inherit original-config)
   (configurations
    (apply append (home-emacs-configuration-configurations original-config)
           (map home-emacs-extension-configurations extension-configs)))))

(define (home-emacs-shepherd-service config)
  (list
   (shepherd-service
    (documentation "Start Emacs")
    (provision '(emacs))
    (auto-start? #t)
    (start
     #~(make-forkexec-constructor
        (list #$(file-append (home-emacs-configuration-package config) "/bin/emacs")
              "--fg-daemon")
        #:log-file (format #f "~a/.local/var/log/xbindkeys.log" (getenv "HOME"))))
    (stop #~(make-kill-destructor)))))

(define (home-emacs-config-files config)
  `((".emacs.d/init.el"
     ,(mixed-text-file
       "init.el"
       (serialize-text-config config (home-emacs-configuration-configurations config))))))

(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
           home-emacs-shepherd-service)
          (service-extension
           home-files-service-type
           home-emacs-config-files)))
   (compose identity)
   (extend home-emacs-extensions)
   (default-value (home-emacs-configuration))
   (description "Install and configure Emacs.")))

;;; Emacs Helpful

(define-configuration/no-serialization home-emacs-helpful-configuration
  (package
    (package emacs-helpful)
    "Package to use for setting emacs-helpful.")
  (configurations
   (text-config '())
   "Configuration for emacs-helpful."))

(define (add-emacs-helpful config)
  (home-emacs-extension
   (configurations (home-emacs-helpful-configuration-configurations config))))

(define (add-emacs-helpful-packages config)
  (list (home-emacs-helpful-configuration-package config)))

(define home-emacs-helpful-service-type
  (service-type
   (name 'home-emacs-helpful)
   (extensions
    (list (service-extension
           home-emacs-service-type
           add-emacs-helpful)
          (service-extension
           home-profile-service-type
           add-emacs-helpful-packages)))
   (compose identity)
   (default-value (home-emacs-helpful-configuration))
   (description "Install and configure emacs-helpful.")))

;;; Emacs Yasnippet Capf

(define-configuration/no-serialization home-emacs-yasnippet-capf-configuration
  (package
    (package emacs-yasnippet-capf)
    "Package to use for setting emacs-yasnippet-capf.")
  (configurations
   (text-config '())
   "Configuration for emacs-yasnippet-capf."))

(define (add-emacs-yasnippet-capf config)
  (home-emacs-extension
   (configurations
    (append
     (list (mixed-text-file "yasnippet-capf-config"
                            "(with-eval-after-load 'minibuffer (add-to-list 'completion-at-point-functions #'yasnippet-capf))\n"))
     (home-emacs-yasnippet-capf-configuration-configurations config)))))

(define (add-emacs-yasnippet-capf-packages config)
  (list (home-emacs-yasnippet-capf-configuration-package config)))

(define home-emacs-yasnippet-capf-service-type
  (service-type
   (name 'home-yasnippet-capf)
   (extensions
    (list (service-extension
           home-emacs-service-type
           add-emacs-yasnippet-capf)
          (service-extension
           home-profile-service-type
           add-emacs-yasnippet-capf-packages)))
   (compose identity)
   (default-value (home-emacs-yasnippet-capf-configuration))
   (description "Install and configure emacs-yasnippet-capf.")))

;;; Emacs Dashboard

(define-configuration/no-serialization home-emacs-dashboard-configuration
  (package
    (package emacs-dashboard)
    "Package to use for setting emacs-dashboard.")
  (configurations
   (text-config '())
   "Configuration for emacs-dashboard."))

(define (add-emacs-dashboard config)
  (home-emacs-extension
   (configurations
    (append
     (list (mixed-text-file "dashboard-config"
                            "(dashboard-setup-startup-hook)\n"
                            "(setq initial-buffer-choice (lambda () (get-buffer-create \"*dashboard*\")))\n"))
     (home-emacs-dashboard-configuration-configurations config)))))

(define (add-emacs-dashboard-packages config)
  (list (home-emacs-dashboard-configuration-package config)))

(define home-emacs-dashboard-service-type
  (service-type
   (name 'home-emacs-dashboard)
   (extensions
    (list (service-extension
           home-emacs-service-type
           add-emacs-dashboard)
          (service-extension
           home-profile-service-type
           add-emacs-dashboard-packages)))
   (compose identity)
   (default-value (home-emacs-dashboard-configuration))
   (description "Install and configure emacs-dashboard.")))

;;; Emacs Eros

(define-configuration/no-serialization home-emacs-eros-configuration
  (package
    (package emacs-eros)
    "Package to use for setting emacs-eros.")
  (configurations
   (text-config '())
   "Configuration for emacs-eros."))

(define (add-emacs-eros config)
  (home-emacs-extension
   (configurations
    (append
     (list (mixed-text-file "eros-config"
                            "(eros-mode)\n"))
     (home-emacs-eros-configuration-configurations config)))))

(define (add-emacs-eros-packages config)
  (list (home-emacs-eros-configuration-package config)))

(define home-emacs-eros-service-type
  (service-type
   (name 'home-emacs-eros)
   (extensions
    (list (service-extension
           home-emacs-service-type
           add-emacs-eros)
          (service-extension
           home-profile-service-type
           add-emacs-eros-packages)))
   (compose identity)
   (default-value (home-emacs-eros-configuration))
   (description "Install and configure emacs-eros.")))

;;; Emacs Ace Link

(define-configuration/no-serialization home-emacs-ace-link-configuration
  (package
    (package emacs-ace-link)
    "Package to use for setting emacs-ace-link.")
  (default-key
    (string "o")
    "Key to use as the default keybinding.")
  (goto-address-key
   maybe-string
   "Key to use (if any) to bind with goto-address-mode.")
  (org-mode-key
   maybe-string
   "Key to use (if any) to bind with org-mode.")
  (configurations
   (text-config '())
   "Configuration for emacs-ace-link."))

(define (add-emacs-ace-link config)
  (home-emacs-extension
   (configurations
    (append
     (list (mixed-text-file "ace-link-config"
                            ";;;;; ace-link-config starts here.\n"
                            (format #f "(ace-link-setup-default (kbd ~s))~%"
                                    (home-emacs-ace-link-configuration-default-key config))
                            (let ((goto-address-key
                                   (home-emacs-ace-link-configuration-goto-address-key config)))
                              (if (maybe-value-set? goto-address-key)
                                  (string-append (format #f "(defun ace-link-config-set-goto-address-key () (local-set-key (kbd ~s) 'ace-link-addr))~%" goto-address-key)
                                                 "(add-hook 'goto-address-prog-mode-hook #'ace-link-config-set-goto-address-key)\n"
                                                 "(add-hook 'goto-address-mode-hook #'ace-link-config-set-goto-address-key)\n")
                                  ""))
                            (let ((org-mode-key
                                   (home-emacs-ace-link-configuration-org-mode-key config)))
                              (if (maybe-value-set? org-mode-key)
                                  (format #f "(with-eval-after-load 'org (define-key org-mode-map (kbd ~s) 'ace-link-org))\n" org-mode-key)
                                  ""))
                            ";;;;; ace-link-config ends here.\n"))
     (home-emacs-ace-link-configuration-configurations config)))))

(define (add-emacs-ace-link-packages config)
  (list (home-emacs-ace-link-configuration-package config)))

(define home-emacs-ace-link-service-type
  (service-type
   (name 'home-emacs-ace-link)
   (extensions
    (list (service-extension
           home-emacs-service-type
           add-emacs-ace-link)
          (service-extension
           home-profile-service-type
           add-emacs-ace-link-packages)))
   (compose identity)
   (default-value (home-emacs-ace-link-configuration))
   (description "Install and configure emacs-ace-link.")))

;;; Emacs Ace-link notmuch

(define-configuration/no-serialization home-emacs-ace-link-notmuch-configuration
  (package
    (package emacs-ace-link-notmuch)
    "Package to use for setting emacs-ace-link-notmuch.")
  (default-key
    (string "o")
    "Key to use as the default keybinding.")
  (configurations
   (text-config '())
   "Configuration for emacs-ace-link-notmuch."))

(define (add-emacs-ace-link-notmuch config)
  (home-emacs-extension
   (configurations
    (append
     (list (mixed-text-file "ace-link-notmuch-config"
                            ";;;;; ace-link-notmuch-config starts here.\n"
                            (format #f "(ace-link-notmuch-setup-default (kbd ~s))~%"
                                    (home-emacs-ace-link-notmuch-configuration-default-key config))
                            ";;;;; ace-link-notmuch-config ends here.\n"))
     (home-emacs-ace-link-notmuch-configuration-configurations config)))))

(define (add-emacs-ace-link-notmuch-packages config)
  (list (home-emacs-ace-link-notmuch-configuration-package config)))

(define home-emacs-ace-link-notmuch-service-type
  (service-type
   (name 'home-emacs-ace-link-notmuch)
   (extensions
    (list (service-extension
           home-emacs-service-type
           add-emacs-ace-link-notmuch)
          (service-extension
           home-profile-service-type
           add-emacs-ace-link-notmuch-packages)))
   (compose identity)
   (default-value (home-emacs-ace-link-notmuch-configuration))
   (description "Install and configure emacs-ace-link-notmuch.")))

;;; Emacs Golden Ratio

(define-configuration/no-serialization home-emacs-golden-ratio-configuration
  (package
    (package emacs-golden-ratio)
    "Package to use for setting emacs-golden-ratio.")
  (configurations
   (text-config '())
   "Configuration for emacs-golden-ratio."))

(define (add-emacs-golden-ratio-configuration config)
  (home-emacs-extension
   (configurations
    (append
     (list (mixed-text-file "golden-ratio-config"
                            ";;;;; golden-ratio-config starts here.\n"
                            "(golden-ratio-mode)\n"
                            "(with-eval-after-load 'ace-window\n"
                            "  (advice-add 'ace-window :after #'golden-ratio))\n"
                            ";;;;; golden-ratio-config ends here.\n"))
     (home-emacs-golden-ratio-configuration-configurations config)))))

(define (add-emacs-golden-ratio-packages config)
  (list (home-emacs-golden-ratio-configuration-package config)))

(define home-emacs-golden-ratio-service-type
  (service-type
   (name 'home-emacs-golden-ratio)
   (extensions
    (list (service-extension
           home-emacs-service-type
           add-emacs-golden-ratio-configuration)
          (service-extension
           home-profile-service-type
           add-emacs-golden-ratio-packages)))
   (compose identity)
   (default-value (home-emacs-golden-ratio-configuration))
   (description "Install and configure emacs-golden-ratio.")))

;;; Emacs Pinentry

(define-configuration/no-serialization home-emacs-pinentry-configuration
  (package
    (package emacs-pinentry)
    "Package to use for setting emacs-pinentry.")
  (auto-start?
   (boolean #t)
   "Should Emacs pinentry be enabled automatically?")
  (extra-content
   (text-config '())
   "Extra content for emacs-pinentry configuration."))

(define (add-emacs-pinentry-configuration config)
  (home-emacs-extension
   (configurations
    (append
     (list (mixed-text-file "pinentry-config"
                            ";;;;; pinentry-config starts here.\n"
                            (if (home-emacs-pinentry-configuration-auto-start? config)
                                "(pinentry-start)\n"
                                "")
                            ";;;;; pinentry-config ends here.\n"))
     (home-emacs-pinentry-configuration-extra-content config)))))

(define (add-emacs-pinentry-packages config)
  (list (home-emacs-pinentry-configuration-package config)))

(define home-emacs-pinentry-service-type
  (service-type
   (name 'home-emacs-pinentry)
   (extensions
    (list (service-extension
           home-emacs-service-type
           add-emacs-pinentry-configuration)
          (service-extension
           home-profile-service-type
           add-emacs-pinentry-packages)))
   (compose identity)
   (default-value (home-emacs-pinentry-configuration))
   (description "Install and configure emacs-pinentry.")))

;;; Emacs Vterm

(define-configuration/no-serialization home-emacs-vterm-configuration
  (package
    (package emacs-vterm)
    "Package to use for setting emacs-vterm.")
  (buffer-name-string
   maybe-string
   "Format string for the title of vterm buffers.")
  (extra-content
   (text-config '())
   "Extra content for emacs-pinentry configuration."))

(define (add-emacs-vterm-configuration config)
  (home-emacs-extension
   (configurations
    (append
     (list (mixed-text-file "vterm-config"
                            ";;;;; vterm-config starts here.\n"
                            (let ((buffer-name-string (home-emacs-vterm-configuration-buffer-name-string config)))
                              (if (maybe-value-set? buffer-name-string)
                                  (format #f "(setq vterm-buffer-name-string ~s)\n" buffer-name-string)
                                  ""))
                            ";;;;; vterm-config ends here.\n"))
            (home-emacs-vterm-configuration-extra-content config)))))

(define (add-emacs-vterm-zsh-configuration config)
  (home-zsh-extension
   (zshrc
    (list
     (mixed-text-file
      "vterm-config"
      "##### vterm-config starts here.\n"
      "vterm_printf() {\n"
      "  if [ -n \"$TMUX\" ] && ([ \"${TERM%%-*}\" = \"tmux\" || [ \"${TERM%%-*}\" = \"screen\" ]); then\n"
      "    # Tell tmux to pass the escape sequence through\n"
      "    printf \"\\ePtmux;\\e\\e]%s\\007\\e\\\\\" \"$1\"\n"
      "  elif [ \"${TERM%%-*}\" = \"screen\" ]; then\n"
      "    # GNU screen (screen, screen-256color, screen-256color-bce)\n"
      "    printf \"\\eP\\e]%s\\007\\e\\\\\" \"$1\"\n"
      "  else\n"
      "    printf \"\\e]%s\\e\\\\\" \"$1\"\n"
      "  fi\n"
      "}\n"
      "if [[ \"$INSIDE_EMACS\" = 'vterm' ]]; then\n"
      "  alias clear='vterm_printf \"51;Evterm-clear-scrollback\";tput clear'\n"
      "fi\n"
      (if (maybe-value-set? (home-emacs-vterm-configuration-buffer-name-string config))
          (string-append
           "autoload -U add-zsh-hook\n"
           "add-zsh-hook -Uz chpwd (){ print -Pn \"\\e]2;%m:%2~\\a\" }\n")
          "")
      "vterm_prompt_end() {\n"
      "  vterm_printf \"51;A$(whoami)@$(hostname):$(pwd)\"\n"
      "}\n"
      "setopt PROMPT_SUBST\n"
      "PROMPT=$PROMPT'%{$(vterm_prompt_end)%}'\n"
      "vterm_cmd() {\n"
      "  local vterm_elisp\n"
      "  vterm_elisp=\"\"\n"
      "  while [ $# -gt 0 ]; do\n"
      "    vterm_elisp=\"$vterm_elisp\"\"$(printf '\"%s\" ' \"$(printf \"%s\" \"$1\" | sed -e 's|\\\\|\\\\\\\\|g' -e 's|\"|\\\\\"|g')\")\"\n"
      "    shift\n"
      "  done\n"
      "  vterm_printf \"51;E$vterm_elisp\"\n"
      "}\n"
      "##### vterm-config ends here.\n")))))

(define (add-emacs-vterm-packages config)
  (list (home-emacs-vterm-configuration-package config)))

(define home-emacs-vterm-service-type
  (service-type
   (name 'home-emacs-vterm)
   (extensions
    (list (service-extension
           home-emacs-service-type
           add-emacs-vterm-configuration)
          (service-extension
           home-zsh-service-type
           add-emacs-vterm-zsh-configuration)
          (service-extension
           home-profile-service-type
           add-emacs-vterm-packages)))
   (compose identity)
   (default-value (home-emacs-vterm-configuration))
   (description "Install and configure emacs-vterm.")))