~abcdw/rde

rde/rde/features/terminals.scm -rw-r--r-- 6.3 KiB
e98d6a8eAndrew Tropin rde: gnupg: Add copyright preamble. 20 hours ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
;;; rde --- Reproducible development environment.
;;;
;;; Copyright © 2021, 2022 Andrew Tropin <andrew@trop.in>
;;;
;;; This file is part of rde.
;;;
;;; rde 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.
;;;
;;; rde 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 rde.  If not, see <http://www.gnu.org/licenses/>.

(define-module (rde features terminals)
  #:use-module (rde features)
  #:use-module (rde features emacs)
  #:use-module (rde features predicates)
  #:use-module (rde features fontutils)
  #:use-module (gnu home services)
  #:use-module (gnu home-services base)
  #:use-module (gnu home-services terminals)
  #:use-module (gnu home-services shells)
  #:use-module (gnu home-services wm)
  #:use-module (gnu services)
  #:use-module (rde packages)
  #:use-module (rde packages emacs-xyz)
  #:use-module (gnu packages terminals)
  #:use-module (guix gexp)

  #:export (feature-alacritty
            feature-vterm))

(define (font-weight->style weight)
  "Transform kebab-cased symbols to capitalized strings without dashes."
  (string-capitalize (string-delete #\- (symbol->string weight))))

(define* (feature-alacritty
          #:key
          config-file
          (package alacritty)
          (default-terminal? #f)
          (backup-terminal? #t)
          (software-rendering? #f))
  "Configure Alacritty terminal."
  (ensure-pred maybe-file-like? config-file)
  (ensure-pred any-package? package)

  ;; TODO: Implement home service and rewrite to it to make this
  ;; feature extendable.
  (define (alacritty-home-services config)
    "Returns home services related to Alacritty."
    (define font-mono (get-value 'font-monospace config))
    (list
     (service
      home-alacritty-service-type
      (home-alacritty-configuration
       (package package)
       (config
        `((window . ((padding . ((x . 10)
                                 (y . 5)))))
          ,@(if software-rendering?
                '((env . ((LIBGL_ALWAYS_SOFTWARE . "1"))))
                '())
          ,@(if font-mono
                `((font . ((normal . ((style . , (font-weight->style
                                                  (font-weight font-mono)))
                                      (family . ,(font-name font-mono))))
                           (size . ,(font-size font-mono)))))
              '())
          ,@(if config-file
                `((import . #(,config-file)))
                '())))))))

  (feature
   (name 'alacritty)
   (values
    `((alacritty . ,package)
      ,@(if default-terminal?
            `((default-terminal . ,(file-append package "/bin/alacritty")))
            '())
      ,@(if backup-terminal?
            `((backup-terminal . ,(file-append package "/bin/alacritty")))
            '())))
   (home-services-getter alacritty-home-services)))


(define* (feature-vterm
          #:key
          (emacs-vterm emacs-vterm-latest))
  "Configure emacs-vterm and shells."
  (ensure-pred file-like? emacs-vterm)

  (define (get-home-services config)
    (require-value 'emacs config)
    (define setup-vterm (local-file "./zsh/vterm" "setup-vterm"))

    (list
     (rde-elisp-configuration-service
      'vterm
      config
      `((define-key global-map (kbd "s-t") 'vterm)
        ,@(if (get-value 'emacs-consult config)
              `((eval-when-compile
                 (require 'cl-macs))

                (with-eval-after-load
                 'vterm
                 (defun vterm-consult-yank-pop-wrapper (orig-fun &rest args)
                   "Use `vterm-insert' instead of `insert-for-yank' if
`major-mode' is `vterm-mode'."
                   (interactive "p")
                   (if (equal major-mode 'vterm-mode)
                       (let ((inhibit-read-only t)
                             (yank-undo-function (lambda (_s _e) (vterm-undo))))
                         (cl-letf (((symbol-function 'insert-for-yank)
                                    'vterm-insert))
                                  (apply orig-fun args)))
                       (apply orig-fun args)))

                 (advice-add 'consult-yank-pop :around
                             'vterm-consult-yank-pop-wrapper)))
              '())
        ,@(if (get-value 'emacs-project config)
              `((with-eval-after-load
                 'project
                 (defun project-vterm ()
                   "Start vterm in the current project's root directory.
If a buffer already exists for running vterm in the project's root,
switch to it.  Otherwise, create a new vterm buffer.
With \\[universal-argument] prefix arg, create a new vterm buffer even
if one already exists."
                   (interactive)
                   (let* ((default-directory (project-root (project-current t)))
                          (vterm-buffer-name (project-prefixed-buffer-name "vterm"))
                          (vterm-buffer (get-buffer vterm-buffer-name)))
                     (if (and vterm-buffer (not current-prefix-arg))
                         (pop-to-buffer-same-window vterm-buffer)
                         (vterm t))))
                 (define-key project-prefix-map (kbd "t") 'project-vterm)))
              '()))
      #:summary "\
Full-fledged terminal in Emacs"
      #:commentary "\
Adds integration with zsh, `consult-yank' and `project-prefix-map', provides
`s-t' hotkey."
      #:keywords '(convenience)
      #:elisp-packages `(,emacs-vterm
                         ,@(if (get-value 'emacs-consult config)
                               (list (get-value 'emacs-consult config))
                               '())))

     (when (get-value 'zsh config)
       (simple-service
        'emacs-vterm-zsh-configuration
        home-zsh-service-type
        (home-zsh-extension
         (zshrc
          (list #~(format #f "source ~a" #$setup-vterm))))))))

  (feature
   (name 'vterm)
   (values
    `((vterm . #t)
      (emacs-vterm . ,emacs-vterm)))
   (home-services-getter get-home-services)))