blob: bf5640fe22289d29ff22246d6434ef6b0bce387c (
plain)
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
|
;;; -*- lexical-binding: t -*-
;;;
;;; Copyright © 2022 David Thompson <davet@gnu.org>
;;;
;;; emacs-guix-shell 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.
;;;
;;; emacs-guix-shell 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 this program. If not, see
;;; <http://www.gnu.org/licenses/>.
(defvar guix-shell--search-paths '()
"Project environment variable cache.")
(defun guix-shell--current-directory ()
(project-root (project-current)))
(defvar guix-shell--hooks '(post-command-hook before-hack-local-variables-hook)
"Hooks that guix shell should hook into.")
(defvar guix-shell--last-directory nil
"The last directory used for running guix shell.")
(defun guix-shell--search-paths-for-directory (directory)
(let ((buffer (get-buffer-create "*guix-shell-temp*"))
(names '()))
(with-current-buffer buffer
(setq default-directory directory)
(erase-buffer)
(call-process "guix" nil t nil "shell" "--search-paths")
;; Gather up the names of all the environment variables and transform
;; the lines into echo commands that we can eval to get the actual
;; search path values.
(goto-char (point-min))
(while (not (eobp))
(let ((start (point)))
(forward-word)
(let ((word (buffer-substring-no-properties start (point))))
(if (string-equal word "export")
(progn
(forward-whitespace 1)
(delete-backward-char (- (point) start))
(let ((var-start (point)))
(search-forward "=")
(backward-char 1)
(push (buffer-substring-no-properties var-start (point)) names)
(delete-backward-char (- (point) var-start)))
(delete-char 1)
(insert "echo ")
(beginning-of-line)
(forward-line 1))
(progn
(goto-char start)
(kill-whole-line))))))
(setq names (reverse names))
;; Eval the search paths.
(call-process-region (point-min) (point-max) "sh" t t nil)
;; Iterate over the result lines and create an environment variable
;; mapping.
(goto-char (point-min))
(let ((env-vars '()))
(dolist (var names)
(let ((start (point)))
(end-of-line 1)
(let ((search-path (buffer-substring-no-properties start (point))))
(push (cons var search-path) env-vars))
(beginning-of-line)
(forward-line 1)))
(kill-buffer buffer)
env-vars))))
(defun guix-shell--update-search-paths-for-directory (directory)
(when directory
(let ((search-paths (guix-shell--search-paths-for-directory directory)))
(setq guix-shell--search-paths
(cons (cons directory search-paths)
(assoc-delete-all directory guix-shell--search-paths)))
search-paths)))
(defun guix-shell--cached-search-paths-for-directory (directory)
(cdr (assoc directory guix-shell--search-paths)))
(defun guix-shell--apply-search-paths (search-paths)
(dolist (pair search-paths)
(let ((name (car pair))
(search-path (cdr pair)))
(setenv name search-path)
(when (string-equal name "PATH")
(setq exec-path (append (parse-colon-path search-path)
(list exec-directory)))))))
(defun guix-shell--apply-search-paths-for-directory (directory)
;; TODO: What if the search paths have been updated and need to be
;; re-applied? This doesn't account for that case currently. The only way
;; to update would be to switch to a buffer in a different project and then
;; change back.
(when (and directory
(not (string-equal directory guix-shell--last-directory)))
(guix-shell--apply-search-paths
(or (guix-shell--cached-search-paths-for-directory directory)
(guix-shell--update-search-paths-for-directory directory)))
(setq guix-shell--last-directory directory)))
(defun guix-shell--apply-search-paths-for-current-directory ()
(guix-shell--apply-search-paths-for-directory (guix-shell--current-directory)))
(defun guix-shell-enable ()
(interactive)
(dolist (hook guix-shell--hooks)
(add-hook hook #'guix-shell--apply-search-paths-for-current-directory)))
(defun guix-shell-disable ()
(interactive)
(dolist (hook guix-shell--hooks)
(remove-hook hook #'guix-shell--apply-search-paths-for-current-directory)))
(defun guix-shell-update ()
(interactive)
(guix-shell--update-search-paths-for-directory
(guix-shell--current-directory)))
|
